Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Applications/NIH Image 1.62b11/src/Macros1.p

Text File | 1997-05-05 | 132.0 KB | 6,020 lines | [TEXT/CWIE]

unit Macros1;
{Contains the recursive descent parser/interpreter}
{for NIH Image's Pascal-like macro language.}

{References:}
{  "Pascal User Manual and Report", Kathleen Jensen and Niklaus Wirth, Springer-Verlag}
{  "Building Your Own C Interpreter", Dr. Dobb's Journal, August 1989}

interface

    uses
        Types, Memory, QuickDraw, QuickDrawText, Packages, Menus, Events, Fonts,
        Scrap, ToolUtils, Resources, Errors, Palettes, StandardFile, Windows, OSUtils,
        Controls, TextEdit, Files, Dialogs, TextUtils, Finder, MixedMode, Processes,
        Folders, ColorPicker,
        Globals, Utilities, RealUtils, Graphics, Edit, Dialogs, Files, Windows,
        Analysis, Camera, File1, File2, Filters, Macros2, Stacks, Lut, Background,
        User, Devices, Serial, PlugIns, Text, projection, math, fft, Edm;


    procedure RunMacro (nMacro: integer);
    procedure RunKeyMacro (ch: char; KeyCode: integer);
    procedure CloseSerialPorts;


implementation

    const
        EndExpected = '"end" or ";" expected';
        ThenExpected = '"then" expected';
        DivideByZero = 'Divide by zero';
        DoExpected = '"do" expected';
        UntilExpected = '"until" expected';
        RightParenExpected = '")" expected';
        NoImageOpen = 'No Image open';
        MaxArgs = 25;
        MaxLoopCount = 20;

    var
        nSaves, ErrorPC, LineStartPC: integer;
        SaveBackground: integer;
        SavePicWidth, SavePicHeight: LongInt;
        SaveMethod: rsMethodType;
        SaveCreate, SaveInvertY, SaveScaleArithmetic, SaveScaleConvolutions: boolean;
        SaveCurrentFontID, SaveCurrentSize, SaveTextJust: integer;
        SaveCurrentStyle: Style;
        SaveTextBack: TextBackType;
        SaveAngle, SaveH, SaveV: extended;
        DoOption, MacroOpPending, StringsAllocated, InPhotoMode: boolean;
        RoutinesCalled: set of CommandType;
        MacroTicks: LongInt;
        LoopCounter: LongInt;



    procedure test;
    var
      op:TokenTypeX;
    begin
        op:=token;
    end;


    function GetExpression: extended;
    forward;
    function GetBooleanExpression: extended;
    forward;
    procedure DoStatement;
    forward;
    procedure SkipStatement;
    forward;
    procedure DoFor;
    forward;
    procedure MacroError (str: str255);
    forward;
    function GetString: str255;
    forward;
    function GetInteger: LongInt;
    forward;
    procedure SkipIf;
    forward;
    procedure SkipPartialStatement;
    forward;
    procedure DoUserFunction;
    forward;


{$S MacroUtil}
{Routines from here to the $S compiler directive go in the MacroUtil segment}




    procedure PutTokenBack;
    begin
        if token <> DoneT then begin
                pc := SavePC;
                token := SaveToken;
            end;
    end;


    procedure DeallocateStrings (first, last: integer);
        var
            i: integer;
    begin
        with MacrosP^ do begin
                for i := first to last do begin
                        if Stack[i].StringH <> nil then begin
                                DisposeHandle(handle(Stack[i].StringH));
                                Stack[i].StringH := nil;
                            end;
                    end;
            end;
    end;


    procedure TrimString (var str: str255);
    begin
        if length(str) > 0 then begin
                while (length(str) > 1) and (str[1] = ' ') do
                    delete(str, 1, 1);
                while (length(str) > 1) and ((str[length(str)] = ' ') or (str[length(str)] = ';')) do
                    delete(str, length(str), 1);
            end;
    end;


    procedure LookupVariable;
        var
            VarFound: boolean;
            i: integer;
    begin
        with MacrosP^ do begin
                VarFound := false;
                i := TopOfStack + 1;
                repeat
                    i := i - 1;
                    VarFound := SymbolTableLoc = Stack[i].SymbolTableIndex
                until VarFound or (i = 1);
                if VarFound then
                    with stack[i] do begin
                            TokenValue := value;
                            if vType <> StringVar then
                                token := Variable
                            else begin
                                    token := StringVariable;
                                    if StringH <> nil then
                                        TokenStr := StringH^^
                                    else
                                        TokenStr := 'Deallocated String';
                                end;
                            TokenStackLoc := i;
                        end;
            end; {with}
    end;


    function FetchInteger: integer;
        var
            temp: integer;
    begin
        with macrosP^ do begin
                temp := ord(macros[pc]);
                pc := pc + 1;
                FetchInteger := bor(bsl(temp, 8),  ord(macros[pc]));
                pc := pc + 1;
            end;
    end;


    procedure LookupProcedureOrFunction;
    begin
        with MacrosP^ do begin
                SymbolTableLoc := FetchInteger;
                with SymbolTable[SymbolTableLoc] do begin
                        TokenLoc := loc;
                        TokenSymbol := symbol;
                    end;
            end;
    end;


function FetchReal: real;
        type
            bytes=packed array[1..4] of char;
        var
            vrec:record
                case integer of
                    1: (rv: real);
                    2: (b: bytes)
                end;
    begin
        with macrosP^,vrec do begin
            b[1] := macros[pc];
            pc := pc + 1;
            b[2] := macros[pc];
            pc := pc + 1;
            b[3] := macros[pc];
            pc := pc + 1;
            b[4] := macros[pc];
            pc := pc + 1;
            FetchReal:=rv;
        end;
    end;


    procedure GetToken;
    begin
        with MacrosP^ do begin
                if token = DoneT then
                    exit(GetToken);
                SavePC := PC;
                SaveToken := token;
                token := TokenTypeX(ord(macros[pc]));
                while token = NewLineT do begin
                        MacroLineNumber := MacroLineNumber + 1;
                        pc := pc + 1;
                        LineStartPC := pc;
                        if pc > EndMacros then begin
                                Token := DoneT;
                                exit(GetToken);
                            end;
                        SavePC := PC;
                        SaveToken := token;
                        token := TokenTypeX(band(ord(macros[pc]),255));
                    end;
                pc := pc + 1;
                if pc > EndMacros then begin
                        Token := DoneT;
                        exit(GetToken);
                    end;
                case token of
                    CommandT, FunctionT, StringFunctionT, ArrayT:
                        begin
                            MacroCommand := CommandType(ord(macros[pc]));
                            pc := pc + 1;
                        end;
                    Identifier:  begin
                            SymbolTableLoc := FetchInteger;
                            if TopOfStack > 0 then
                                LookupVariable;
                        end;
                    ProcedureT, UserFunctionT:
                        LookupProcedureOrFunction;
                    NumericLiteral:
                        TokenValue := FetchReal;
                    StringLiteral:  begin
                            TokenStr := '';
                            while ord(macros[pc]) <> 0 do begin
                                    TokenStr := Concat(TokenStr, macros[pc]);
                                    pc := pc + 1;
                                end;
                            pc := pc + 1;
                        end;
                end; {case}
            end; {with}
    end;


    procedure GetMacroName;
        var
            i, len: integer;
    begin
        with MacrosP^ do begin
                pc := PCStart;
                repeat
                    pc := pc - 1;
                    if pc < 0 then
                        exit(GetMacroName);
                until macros[pc] = chr(ord(MacroT));
                GetToken; {MacroT}
                GetToken; {Macro name}
                if Token = StringLiteral then begin
                        len := length(TokenStr);
                        if len > SymbolSize then
                            len := SymbolSize;
                        for i := 1 to len do
                            MacroOrProcName[i] := TokenStr[i];
                    end;
            end;
    end;


    procedure ConvertTokenToString (var str: str255);
        var
            i, j, len: integer;
    begin
        with MacrosP^ do
            case token of
                semicolon:
                    str := ';';
                comma:
                    str := ',';
                colon:
                    str := ':';
                LeftParen:
                    str := '(';
                RightParen:
                    str := ')';
                LeftBracket:
                    str := '[';
                RightBracket:
                    str := ']';
                PlusOp:
                    str := '+';
                MinusOp:
                    str := '-';
                MulOp:
                    str := '*';
                DivOp:
                    str := '/';
                eqOp:
                    str := '=';
                ltOp:
                    str := '<';
                gtOp:
                    str := '>';
                neOp:
                    str := '<>';
                leOp:
                    str := '<=';
                geOp:
                    str := '>=';
                orOp:
                    str := 'or';
                IntDivOp:
                    str := 'div';
                modOp:
                    str := 'mod';
                andOp:
                    str := 'and';
                NotOp:
                    str := 'not';
                AssignOp:
                    str := ':=';
                Identifier, Variable, StringVariable, ProcIdT, UserFuncIdT:  begin
                        for i := 1 to SymbolSize do
                            str := Concat(str, SymbolTable[SymbolTableLoc].symbol[i]);
                        TrimString(str);
                    end;
                NumericLiteral:  begin
                        if trunc(TokenValue) = TokenValue then
                            RealToString(TokenValue, 1, 0, str)
                        else
                            RealToString(TokenValue, 1, 1, str);
                    end;
                StringLiteral:
                    str := concat('''', TokenStr, '''');
                CommandT, FunctionT, StringFunctionT, ArrayT, UserFunctionT:
                    for i := 1 to nSymbols do begin
                            with SymbolTable[i] do
                                if (tType = token) and (MacroCommand = cType) then begin
                                        for j := 1 to SymbolSize do
                                            str := Concat(str, symbol[j]);
                                        TrimString(str);
                                    end;
                        end; {for}
                otherwise
                    for i := 1 to nSymbols do begin
                            with SymbolTable[i] do
                                if tType = token then begin
                                        for j := 1 to SymbolSize do
                                            str := Concat(str, symbol[j]);
                                        TrimString(str);
                                    end;
                        end; {for}
            end; {case}
    end;


    procedure GetErrorLine (var ErrorLine: str255);
        var
            str: str255;
    begin
        with MacrosP^ do begin
                pc := LineStartPC;
                ErrorLine := '';
                repeat
                    str := '';
                    if ord(macros[pc]) = ord(NewLineT) then {ppc-bug}
                        leave;
                    GetToken;
                    ConvertTokenToString(str);
                    if SavePC = ErrorPC then
                        str := concat('«', str, '»');
                    ErrorLine := concat(ErrorLine, ' ', str);
                until token = DoneT;
            end;
    end;


    procedure GetLocalLineNumber;
    begin
        pc := PCStart;
        MacroLineNumber := 1;
        while (pc <= errorpc) and (token <> DoneT) do
            GetToken;
    end;


    procedure GetGlobalLineNumber;
    begin
        pc := 0;
        MacroLineNumber := 1;
        while (pc <= errorpc) and (token <> DoneT) do
            GetToken;
    end;


    procedure MacroError (str: str255);
  {Report run-time errors}
        var
            name, ErrorLine, Line: str255;
            i, count, ignore: integer;
    begin
        with MacrosP^ do begin
                if token = DoneT then
                    exit(MacroError);
                if TopOfStack > 0 then
                    DeAllocateStrings(nGlobals + 1, TopOfStack);
                ErrorPC := SavePC;
                if MacroOrProcName = BlankSymbol then
                    GetMacroName;
                if MacroOrProcName[SymbolSize] <> ' ' then
                    MacroOrProcName[SymbolSize] := '…';
                name:='123456789012';
                for i:=1 to 12 do name[i]:=MacroOrProcName[i];
                TrimString(name);
                GetLocalLineNumber;
                Line := StringOf(MacroLineNumber:1);
                GetErrorLine(ErrorLine);
                InitCursor;
                GetGlobalLineNumber;
                Line:=StringOf(Line,' (',MacroLineNumber:1,')');
                ParamText(str, Line, Name, ErrorLine);
                Ignore := Alert(900, nil);
                Token := DoneT;
            end; {with}
    end;


    procedure DoDeclaration;
        var
            SaveStackLoc, StackLoc: integer;
    begin
        SaveStackLoc := TopOfStack;
        while (token = Identifier) or (token = variable) or (token = comma) or (token = StringVariable) do begin
                if TopOfStack >= MaxMacroStackSize then begin
                        MacroError(StackOverflow);
                        exit(DoDeclaration);
                    end;
                TopOfStack := TopOfStack + 1;
                with MacrosP^.stack[TopOfStack] do begin
                        SymbolTableIndex := SymbolTableLoc;
                        value := 0.0;
                        StringH := nil;
                    end;
                GetToken;
                if token = comma then
                    GetToken;
            end; {while}
        if (token = FunctionT) or (token = StringFunctionT) or (token = CommandT) or (token = ArrayT) then
            MacroError('Predefined identifier');
        if token <> colon then
            MacroError('":" expected');
        GetToken;
        if (token <> IntegerT) and (token <> RealT) and (token <> BooleanT) and (token <> StringT) then
            MacroError('"integer", "real", "boolean" or "string" expected');
        for StackLoc := SaveStackLoc + 1 to TopOfStack do
            with macrosP^.stack[StackLoc] do
                case token of
                    IntegerT:
                        vType := IntVar;
                    RealT:
                        vType := RealVar;
                    BooleanT:
                        vType := BooleanVar;
                    StringT:  begin
                            StringsAllocated := true;
                            vType := StringVar;
                            StringH := str255H(NewHandle(SizeOf(str255)));
                            if StringH = nil then begin
                                    MacroError('Out of memory');
                                    Token := DoneT
                                end
                            else
                                StringH^^ := 'Local String';
                        end;
                    otherwise
                end;
        GetToken;
        if Token = SemiColon then
            GetToken;
    end;


    procedure GetLeftParen;
    begin
        GetToken;
        if token <> LeftParen then
            MacroError('"(" expected');
    end;


    procedure GetRightParen;
    begin
        GetToken;
        if token <> RightParen then
            MacroError(RightParenExpected);
    end;


    procedure GetComma;
    begin
        GetToken;
        if token <> comma then
            MacroError('"," expected');
    end;


    procedure GetArguments (var str: str255);
        var
            width, fwidth: integer;
            i: LongInt;
            isExpression, ZeroFill, noArgs, notFormatted: boolean;
            isUserFunction: boolean;
            n: extended;
            str2: str255;
    begin
        if MacroCommand = WritelnC then begin {Check for Writeln with no arguments}
                GetToken;
                noArgs := token <> LeftParen;
                PutTokenBack;
                if NoArgs then begin
                        str := '';
                        exit(GetArguments);
                    end;
            end;
        ZeroFill := not (MacroCommand in [DrawTextC, WriteC, WritelnC, PutMsgC, ShowMsgC, PutSerialC, ConcatC]);
        width := 4;
        fwidth := 0;
        str := '';
        GetLeftParen;
        GetToken;
        repeat
            notFormatted := true;
            if token = UserFunctionT then begin
                    DoUserFunction;
                    isExpression := TokenStr = 'No return string';
                    if isExpression then
                        n := TokenValue
                    else
                        str2 := TokenStr;
            end else begin
                    isExpression := token in [Variable, NumericLiteral, FunctionT, TrueT, FalseT, ArrayT, MinusOp, LeftParen];
                    PutTokenBack;
                    if isExpression then
                        n := GetBooleanExpression
                    else
                        str2 := GetString;
            end;
            GetToken;
            if token = colon then begin
                    notFormatted := false;
                    width := GetInteger;
                    if width < 0 then
                        width := 0;
                    if width > 100 then
                        width := 100;
                    GetToken;
                    if token = colon then begin
                            fwidth := GetInteger;
                            if fwidth < 0 then
                                width := 0;
                            if fwidth > 12 then
                                width := 12;
                            GetToken;
                        end;
                end;
            if token = comma then
                GetToken;
            if isExpression then begin
                    if notFormatted then
                        if (trunc(n) <> n) and (not ZeroFill) then begin
                                width := 1;
                                fwidth := 4;
                            end;
                    str2:=StringOf(n:width:fwidth);
                    if ZeroFill and (n >= 0) then
                        for i := 1 to width do
                            if str2[i] = ' ' then
                                str2[i] := '0';
                end;
            str := concat(str, str2);
        until (token = RightParen) or (token = DoneT);
    end;


    function DoGetString: str255; {(prompt,default:str255)}
        const
            StringID = 3;
        var
            prompt, default: str255;
            Canceled: boolean;
            mylog: DialogPtr;
            item: integer;
    begin
        GetLeftParen;
        prompt := GetString;
        GetToken;
        if token = Comma then
            default := GetString
        else begin
                default := '';
                PutTokenBack
            end;
        GetRightParen;
        if Token <> DoneT then begin
                InitCursor;
                ParamText(prompt, '', '', '');
                mylog := GetNewDialog(170, nil, pointer(-1));
                SetDString(MyLog, StringID, default);
                SelectdialogItemText(MyLog, StringID, 0, 32767);
                OutlineButton(MyLog, ok, 16);
                repeat
                    ModalDialog(nil, item);
                until (item = ok) or (item = cancel);
                if item = ok then
                    DoGetString := GetDString(MyLog, StringID)
                else begin
                        DoGetString := 'cancel';
                        token := DoneT;
                    end;
                DisposeDialog(mylog);
            end;
    end;


    function GetSerial: str255;
        var
            count: LongInt;
            buffer: packed array[1..100] of char;
            err: OSErr;
            c:char;
    begin
        if SerialBufferP = nil then begin
                MacroError('Serial port not open');
                exit(GetSerial);
            end;
        Err := SerGetBuf(SerialIn, count);
        if count > 0 then begin
                count := 1;
            Err := FSRead(SerialIn, count, @buffer);
            c:=buffer[1]; {ppc-bug}
            GetSerial :=c;
            end
        else
            GetSerial := '';
    end;


    procedure RangeCheck (i: LongInt);
    begin
        if (i < 0) or (i > 255) then
            MacroError('Argument is less than 0 or greater than 255');
    end;


    function DoChr: str255;
        var
            i: LongInt;
    begin
        GetLeftParen;
        i := GetInteger;
        GetRightParen;
        RangeCheck(i);
        if Token <> DoneT then begin
            DoChr := chr(i);
        end;
    end;


    function GetWindowTitle: str255;
        var
            wPeek: WindowPeek;
    begin
        wPeek := WindowPeek(FrontWindow);
        if wPeek = nil then begin
                GetWindowTitle := '';
                exit(GetWindowTitle);
            end;
        if wPeek^.WindowKind = PicKind then
            GetWindowTitle := Info^.title
        else
            GetWindowTitle := wPeek^.TitleHandle^^;
    end;


    function GetPath (vRefnum: Integer; DirID: LongInt): Str255;
    { from 'Inside Macintosh: Files' }
    var
      myPB:     CInfoPBRec;
      dirName:  Str255;
      fullPath: Str255;
      myErr:    OSErr;
    begin
      fullPath := '';
      myPB.ioNamePtr := @dirName;
      myPB.ioVRefNum := vRefNum;
      myPB.ioDrParID := DirId;
      myPB.ioFDirIndex := -1;
      repeat
        myPB.ioDrDirID := myPB.ioDrParID;
        myErr := PBGetCatInfoSync(@myPB);
        dirName := concat(dirName, ':');
        fullPath := concat(dirName, fullPath);
      until myPB.ioDrDirID = fsRtDirID;
      GetPath := fullPath;
    end;


    function DoGetPath: str255;
    var
        err: OSErr;
        PrefsVRef: integer;
        PrefsDirID: LongInt;
        PathType: str255;
    begin
        GetLeftParen;
        PathType := GetString;
        GetRightParen;
        if Token <> DoneT then begin
            DoGetPath := '';
            MakeLowerCase(PathType);
            if pos('window', PathType) <> 0 then begin
                if (CurrentWindow = textKind) and (TextInfo <> nil) then begin
                    if TextInfo^.TextRefNum <> 0 then
                        DoGetPath := GetPath(TextInfo^.TextRefNum, 0)
                end else if (CurrentWindow = PicKind) and (info^.vRef <> 0) then
                    DoGetPath := GetPath(info^.vRef, 0)
            end else if pos('start', PathType) <> 0 then
                DoGetPath := GetPath(StartupSpec.vRefNum, StartupSpec.parID)
            else if pos('pref', PathType) <> 0 then begin
                err:=FindFolder(kOnSystemDisk, kPreferencesFolderType,
                    kDontCreateFolder, PrefsVRef, PrefsDirID);
                if err = noErr then
                    DoGetPath := GetPath(PrefsVRef, PrefsDirID)
            end else
                MacroError('Unrecognized argument');
        end;
    end;


    function DoStringFunction: str255;
        var
            str: str255;
    begin
        case MacroCommand of
            GetStringC:
                DoStringFunction := DoGetString;
            ChrC:
                DoStringFunction := DoChr;
            GetSerialC:
                DoStringFunction := GetSerial;
            ConcatC:  begin
                    GetArguments(str);
                    DoStringFunction := str;
                end;
            WindowTitleC:
                DoStringFunction := GetWindowTitle;
            GetPathC:
                DoStringFunction := DoGetPath;
            otherwise
                MacroError('"GetString ", "GetSerial" or "chr" expected');
        end;
    end;


    function GetString: str255;
    begin
        GetToken;
        if token = StringFunctionT then
            GetString := DoStringFunction
        else if (token = StringLiteral) or (token = StringVariable) then
            GetString := TokenStr
        else if token = UserFunctionT then begin
            DoUserFunction;
            GetString := TokenStr
        end else begin
                MacroError('String expected');
                GetString := '';
            end;
    end;


    function GetInteger: LongInt;
        var
            n: LongInt;
            r: extended;
    begin
        r := GetExpression;
        if token = DoneT then begin
                GetInteger := 0;
                exit(GetInteger);
            end;
        GetInteger := round(r);
    end;


    procedure CheckBoolean (b: extended);
    begin
        if (b <> ord(true)) and (b <> ord(false)) then
            MacroError('Boolean expression expected');
    end;


    function GetBoolean: boolean;
        var
            value: extended;
    begin
        value := GetBooleanExpression;
        CheckBoolean(value);
        GetBoolean := value = ord(true);
    end;


    function GetBooleanArg: boolean;
    begin
        GetLeftParen;
        GetBooleanArg := GetBoolean;
        GetRightParen;
    end;


    function GetStringArg: str255;
    begin
        GetLeftParen;
        GetStringArg := GetString;
        GetRightParen;
    end;


    procedure DoConvolve;
        var
            err: OSErr;
            f: integer;
            FileFound: boolean;
            fname: str255;
    begin
        fname := GetStringArg;
        if token <> DoneT then begin
                if (fname = '') and (CurrentWindow = TextKind) then begin
                        ConvolveUsingText;
                        exit(DoConvolve);
                    end;
                err := fsopen(fname, KernelsRefNum, f);
                FileFound := err = NoErr;
                err := fsclose(f);
                if FileFound then
                    convolve(fname, KernelsRefNum)
                else
                    convolve('', 0);
            end;
    end;


    function GetNumber: extended; {(prompt:str255; default:extended; [DefaultDigits:integer])}
        var
            prompt: str255;
            default, n: extended;
            Canceled, OptionalArgument: boolean;
            DefaultDigits: LongInt;
    begin
        GetLeftParen;
        prompt := GetString;
        GetComma;
        default := GetExpression;
        GetToken;
        OptionalArgument := token <> RightParen;
        PutTokenBack;
        if OptionalArgument then begin
                GetComma;
                DefaultDigits := GetInteger;
                if DefaultDigits < 0 then
                    DefaultDigits := 0;
                if DefaultDigits > 5 then
                    DefaultDigits := 5;
        end else
                DefaultDigits := 2;
        GetRightParen;
        n := 0.0;
        if Token <> DoneT then begin
                n := GetReal(prompt, default, DefaultDigits, Canceled);
                if Canceled then begin
                        n := default;
                        token := DoneT;
                    end;
            end;
        GetNumber := n;
    end;


    function DoGetPixel: extended; {(hloc,vloc:integer)}
        var
            hloc, vloc: LongInt;
    begin
        GetLeftParen;
        hloc := GetInteger;
        GetComma;
        vloc := GetInteger;
        GetRightParen;
        if (Token <> DoneT) and (info <> NoInfo) then
            DoGetPixel := MyGetPixel(hloc, vloc)
        else
            DoGetPixel := 0.0;
    end;


    function DoFunction (c: CommandType): extended;
        var
            n: extended;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        n := GetExpression;
        GetRightParen;
        if Token <> DoneT then
            case SaveCommand of
                truncC:
                    DoFunction := trunc(n);
                roundC:
                    DoFunction := round(n);
                oddC:
                    if odd(trunc(n)) then
                        DoFunction := ord(true)
                    else
                        DoFunction := ord(false);
                absC:
                    DoFunction := abs(n);
                sqrtC:
                    if n < 0.0 then
                        MacroError('Sqrt Error')
                    else
                        DoFunction := sqrt(n);
                sqrC:
                    DoFunction := sqr(n);
                sinC:
                    DoFunction := sin(n);
                cosC:
                    DoFunction := cos(n);
                expC:
                    DoFunction := exp(n);
                lnC:
                    if n <= 0.0 then
                        MacroError('Log Error')
                    else
                        DoFunction := ln(n);
                arctanC:
                    DoFunction := arctan(n);
            end
        else
            DoFunction := 0.0;
    end;


    function CalibrateValue: extended;
        var
            i: integer;
    begin
        GetLeftParen;
        i := GetInteger;
        GetRightParen;
        RangeCheck(i);
        if Token <> DoneT then begin
                CalibrateValue := cvalue[i];
            end;
    end;


    function DoOrd: extended;
        var
            str: str255;
    begin
        GetLeftParen;
        str := GetString;
        GetRightParen;
        if Token <> DoneT then begin
                if length(str) >= 1 then
                    DoOrd := ord(str[1])
                else
                    DoOrd := -1;
            end;
    end;


    function DoStringToNum: extended;
        var
            str: str255;
            n: extended;
    begin
        GetLeftParen;
        str := GetString;
        GetRightParen;
        if Token <> DoneT then begin
                n := StringToReal(str);
                if n = BadReal then
                    DoStringToNum := 0.0
                else
                    DoStringToNum := n;
            end;
    end;


    function DoLogicalFunction (c: CommandType): extended;
        var
            n1, n2: LongInt;
    begin
        GetLeftParen;
        n1 := GetInteger;
        GetComma;
        n2 := GetInteger;
        GetRightParen;
        if Token <> DoneT then begin
                if c = BitAndC then
                    DoLogicalFunction := band(n1, n2)
                else
                    DoLogicalFunction := bor(n1, n2)
            end;
    end;


    function PidExists: boolean; {(pid:integer)}
        var
            pid, i: integer;
    begin
        GetLeftParen;
        pid := GetInteger;
        GetRightParen;
        if Token <> DoneT then begin
                PidExists := false;
                for i := 1 to nPics do
                    if InfoPtr(WindowPeek(PicWindow[i])^.RefCon)^.pidNum = pid then begin
                            PidExists := true;
                            leave;
                        end;
            end;
    end;


    function DoPos: integer;
        var
            substr, str: str255;
    begin
        GetLeftParen;
        substr := GetString;
        GetComma;
        str := GetString;
        GetRightParen;
        if Token <> DoneT then
            DoPos := pos(substr, str);
    end;


    function DoLength: integer;
        var
            str: str255;
    begin
        GetLeftParen;
        str := GetString;
        GetRightParen;
        if Token <> DoneT then
            DoLength := length(str);
    end;


    function isKeyDown:boolean; {(key:string)}
        var
            key: str255;
    begin
        GetLeftParen;
        key := GetString;
        GetRightParen;
        if token <> DoneT then begin
            MakeLowerCase(key);
            isKeydown:=false;
            if (pos('option', key) <> 0) and OptionKeyDown then
                isKeyDown:=true
            else if (pos('shift', key) <> 0) and ShiftKeyDown then
                isKeyDown:=true
            else if (pos('control', key) <> 0) and ControlKeyDown then
                isKeyDown:=true;
        end;
    end;


    function GetParameter:LongInt; {parameter:string}
        var
            param: str255;
    begin
        GetLeftParen;
        param := GetString;
        GetRightParen;
        if token <> DoneT then begin
            MakeLowerCase(param);
            if pos('maxmeasure', param) <> 0 then
                GetParameter := MaxMeasurements
            else if pos('undo', param) <> 0 then
                GetParameter := UndoBufSize
            else if pos('freemem', param) <> 0 then
                GetParameter := FreeMem
            else if pos('maxblock', param) <> 0 then
                GetParameter := MaxBlock
            else if pos('offset', param) <> 0 then
                GetParameter := DacLow
            else if pos('gain', param) <> 0 then
                GetParameter := 255 - (DacHigh - DacLow)
            else if pos('width', param) <> 0 then
                GetParameter := ScreenWidth
            else if pos('height', param) <> 0 then
                GetParameter := ScreenHeight
            else if pos('roitype', param) <> 0 then begin
                if info = nil then
                    GetParameter := 0
                else case Info^.RoiType of
                    noRoi: GetParameter := 0;
                    RectRoi: GetParameter := 1;
                    OvalRoi: GetParameter := 2;
                    PolygonRoi: GetParameter := 3;
                    FreehandRoi: GetParameter := 4;
                    TracedRoi: GetParameter := 5;
                    LineRoi: GetParameter := 6;
                    FreeLineRoi: GetParameter := 7;
                    SegLineRoi: GetParameter := 8;
                end
            end else begin
                MacroError('Invalid argument');
                GetParameter := 0;
            end;
        end;
    end;


    function ExecuteFunction: extended;
    begin
        case MacroCommand of
            TruncC, RoundC, oddC, absC, sqrtC, sqrC, sinC, cosC, expC, lnC, arctanC:
                ExecuteFunction := DoFunction(MacroCommand);
            GetNumC:
                ExecuteFunction := GetNumber;
            RandomC:
                ExecuteFunction := (random + 32767.0) / 65534.0;
            GetPixelC:
                ExecuteFunction := DoGetPixel;
            ButtonC:  begin
                    ExecuteFunction := ord(Button);
                    FlushEvents(EveryEvent, 0);
                end;
            nPicsC:
                ExecuteFunction := nPics;
            PicNumC:
                ExecuteFunction := info^.PicNum;
            PidNumC:
                ExecuteFunction := info^.PidNum;
            PidExistsC:
                ExecuteFunction := ord(PidExists);
            SameSizeC:
                ExecuteFunction := ord(AllSameSize);
            cValueC:
                ExecuteFunction := CalibrateValue;
            CalibratedC:
                ExecuteFunction := ord(info^.fit <> uncalibrated);
            rCountC:
                ExecuteFunction := mCount;
            GetSliceC:
                with info^ do
                    if StackInfo = nil then
                        ExecuteFunction := 0
                    else
                        ExecuteFunction := Info^.StackInfo^.CurrentSlice;
            nSlicesC:
                with info^ do
                    if StackInfo = nil then
                        ExecuteFunction := 0
                    else
                        ExecuteFunction := Info^.StackInfo^.nSlices;
            GetSpacingC:
                with info^ do
                    if StackInfo = nil then
                        MacroError('No stack')
                    else with Info^.StackInfo^ do begin
                        if StackType = MovieStack then
                            ExecuteFunction := Info^.StackInfo^.FrameInterval
                        else
                            ExecuteFunction := Info^.StackInfo^.SliceSpacing;
                    end;
            nCoordinatesC:
                ExecuteFunction := nCoordinates;
            OrdC:
                ExecuteFunction := DoOrd;
            TickCountC:
                ExecuteFunction := TickCount;
            StringToNumC:
                ExecuteFunction := DoStringToNum;
            UndoSizeC:
                ExecuteFunction := UndoBufSize;
            BitAndC, BitOrC:
                ExecuteFunction := DoLogicalFunction(MacroCommand);
            PosC:
                ExecuteFunction := DoPos;
            LengthC:
                ExecuteFunction := DoLength;
            KeyDownC:
                ExecuteFunction := ord(isKeyDown);
            GetC:
                ExecuteFunction := GetParameter;
        end; {case}
    end;


    procedure CheckIndex (index, min, max: LongInt);
    begin
        if (index < min) or (index > max) then
            MacroError('Array index out of range');
    end;


    function GetArrayValue: extended;
        var
            SaveArrayType: ArrayType;
            Index: LongInt;
            xcoord, ycoord: integer;
    begin
        SaveArrayType := ArrayType(MacroCommand);
        GetToken;
        if token <> LeftBracket then
            MacroError('"[" expected');
        Index := GetInteger;
        GetToken;
        if token <> RightBracket then
            MacroError('"]" expected');
        case SaveArrayType of
            HistogramA:  begin
                    RangeCheck(Index);
                    GetArrayValue := histogram[Index];
                end;
            rAreaA:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := mArea^[Index];
                end;
            rMeanA:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := mean^[Index];
                end;
            rStdDevA:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := sd^[Index];
                end;
            rXA:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := xcenter^[Index];
                end;
            rYA:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := ycenter^[Index];
                end;
            rLengthA:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := pLength^[Index];
                end;
            rMinA:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := mMin^[Index];
                end;
            rMaxA:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := mMax^[Index];
                end;
            rMajorA:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := MajorAxis^[Index];
                end;
            rMinorA:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := MinorAxis^[Index];
                end;
            rAngleA:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := orientation^[Index];
                end;
            rUser1A:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := User1^[Index];
                end;
            rUser2A:  begin
                    CheckIndex(Index, 1, MaxMeasurements);
                    GetArrayValue := User2^[Index];
                end;
            RedLutA, GreenLutA, BlueLutA:
                if OptionKeyDown then begin
                        RangeCheck(Index);
                        if Token <> DoneT then
                            with cScreenPort^.portPixMap^^.pmTable^^.ctTable[index].rgb do
                                case SaveArrayType of
                                    RedLutA:
                                        GetArrayValue := band(bsr(red, 8), 255);
                                    GreenLutA:
                                        GetArrayValue := band(bsr(green, 8), 255);
                                    BlueLutA:
                                        GetArrayValue := band(bsr(blue, 8), 255);
                                end; {case}
                    end
                else begin
                        RangeCheck(Index);
                        if Token <> DoneT then
                            with osGDevice^^.gdPMap^^.pmTable^^.ctTable[index].rgb do
                                case SaveArrayType of
                                    RedLutA:
                                        GetArrayValue := band(bsr(red, 8), 255);
                                    GreenLutA:
                                        GetArrayValue := band(bsr(green, 8), 255);
                                    BlueLutA:
                                        GetArrayValue := band(bsr(blue, 8), 255);
                                end; {case}
                    end;
            BufferA:  begin
                    CheckIndex(Index, 0, MaxLine - 1);
                    if Token <> DoneT then
                        GetArrayValue := MacrosP^.aLine[index];
                end;
            PlotDataA:  begin
                    CheckIndex(Index, 0, MaxLine - 1);
                    if Token <> DoneT then
                        GetArrayValue := PlotData^[index];
                end;
            xCoordinatesA:  begin
                    CheckIndex(Index, 1, MaxCoordinates);
                    if Token <> DoneT then
                        with info^ do begin
                                xcoord := xCoordinates^[index];
                                if SpatiallyCalibrated then
                                    GetArrayValue := xcoord / xScale
                                else
                                    GetArrayValue := xcoord
                            end;
                end;
            yCoordinatesA:  begin
                    CheckIndex(Index, 1, MaxCoordinates);
                    if Token <> DoneT then
                        with info^ do begin
                                ycoord := yCoordinates^[index];
                                if InvertYCoordinates and (Info <> NoInfo) then
                                    ycoord := Info^.PicRect.bottom - ycoord - 1;
                                if SpatiallyCalibrated then
                                    GetArrayValue := ycoord / yScale
                                else
                                    GetArrayValue := ycoord
                            end;
                end;
            ScionA:  begin
                    if framegrabber <> ScionLG3 then
                        MacroError('No Scion LG-3');
                    if Token <> DoneT then
                        CheckIndex(Index, 1, 4);
                    if Token <> DoneT then
                        case index of
                            1:
                                GetArrayValue := LG3DacA;
                            2:
                                GetArrayValue := LG3DacB;
                            3:
                                GetArrayValue := ControlReg^;
                            4:
                                GetArrayValue := LG3DataOut;
                        end;
                end;
        end; {case}
    end;


    function GetStringValue: extended;
 {Convert string to a base 102 number so we can do comparisons.}
        const
            base = 102;
        var
            i, j: integer;
            v, k: extended;
    begin
        MakeLowerCase(TokenStr);
        k := 1;
        v := 0.0;
        for i := 1 to length(TokenStr) do begin
                j := ord(TokenStr[i]);
                if j > 127 then
                    j := 127;
                if j >= 91 then
                    j := j - 26;
                v := v + j * k;
                k := k * base;
            end;
        GetStringValue := v;
    end;



    function GetValue: extended;
    begin
        case token of
            Variable, NumericLiteral:
                GetValue := TokenValue;
            FunctionT:
                GetValue := ExecuteFunction;
            StringFunctionT:  begin
                    TokenStr := DoStringFunction;
                    GetValue := GetStringValue;
                end;
            UserFunctionT:  begin
                    DoUserFunction;
                    GetValue := TokenValue;
                end;
            TrueT:
                GetValue := ord(true);
            FalseT:
                GetValue := ord(false);
            ArrayT:
                GetValue := GetArrayValue;
            StringVariable, StringLiteral:
                GetValue := GetStringValue;
            otherwise begin
                    MacroError('Number expected');
                    GetValue := 0.0;
                    exit(GetValue);
                end;
        end; {case}
    end;


    function GetFactor: extended;
        var
            fValue: extended;
            isUnaryMinus, isNot: boolean;
    begin
        GetToken;
        isUnaryMinus := token = MinusOp;
        isNot := token = NotOp;
        if isUnaryMinus or isNot then
            GetToken;
        case token of
            Variable, NumericLiteral, FunctionT, UserFunctionT, StringFunctionT,
            TrueT, FalseT, ArrayT, StringVariable, StringLiteral:
                fValue := GetValue;
            LeftParen:  begin
                    fValue := GetBooleanExpression;
                    GetRightParen;
                end;
            otherwise begin
                    macroError('Undefined identifier');
                    fvalue := 0.0
                end;
        end;
        if isUnaryMinus then
            fValue := -fValue;
        if isNot then
            if fValue = ord(true) then
                fValue := ord(false)
            else
                fValue := ord(true);
        GetFactor := fValue;
        GetToken;
    end;


    function GetTerm: extended;
        var
            tValue, fValue: extended;
            op: TokenTypeX;
    begin
        tValue := GetFactor;
        while token in [MulOp, IntDivOp, ModOp, DivOp, AndOp] do begin
                op := token;
                fValue := GetFactor;
                case op of
                    MulOp:
                        tValue := tValue * fValue;
                    IntDivOp:
                        if fValue <> 0.0 then
                            tValue := trunc(tValue) div trunc(fValue)
                        else
                            MacroError(DivideByZero);
                    ModOp:
                        if fValue <> 0.0 then
                            tValue := trunc(tValue) mod trunc(fValue)
                        else
                            MacroError(DivideByZero);
                    DivOp:
                        if fValue <> 0.0 then
                            tValue := tValue / fValue
                        else
                            MacroError(DivideByZero);
                    AndOp:  begin
                            CheckBoolean(tValue);
                            CheckBoolean(fValue);
                            tValue := ord((tValue = ord(true)) and (fValue = ord(true)));
                        end;
                end; {case}
            end; {while}
        GetTerm := tValue;
    end;


    function GetSimpleExpression: extended;
        var
            seValue, tValue: extended;
            op: TokenTypeX;
    begin
        seValue := GetTerm;
        while token in [PlusOp, MinusOp, OrOp] do begin
                op := token;
                tValue := GetTerm;
                case op of
                    PlusOp:
                        seValue := seValue + tValue;
                    MinusOp:
                        seValue := seValue - tValue;
                    orOp:  begin
                            CheckBoolean(seValue);
                            CheckBoolean(tValue);
                            seValue := ord((seValue = ord(true)) or (tValue = ord(true)));
                        end;
                end;
            end;
        GetSimpleExpression := seValue;
    end;


    function GetExpression: extended;
        var
            seValue, tValue: extended;
            op: TokenTypeX;
    begin
        seValue := GetTerm;
        while token in [PlusOp, MinusOp, OrOp] do begin
                op := token;
                tValue := GetTerm;
                case op of
                    PlusOp:
                        seValue := seValue + tValue;
                    MinusOp:
                        seValue := seValue - tValue;
                    orOp:  begin
                            CheckBoolean(seValue);
                            CheckBoolean(tValue);
                            seValue := ord((seValue = ord(true)) or (tValue = ord(true)));
                        end;
                end;
            end;
        GetExpression := seValue;
        PutTokenBack;
    end;


    function GetBooleanExpression: extended;
        var
            eValue, seValue: extended;
            op: TokenTypeX;
    begin
        eValue := GetSimpleExpression;
        while token in [eqOp, ltOp, gtOp, neOp, leOp, geOp] do begin
                op := token;
                seValue := GetSimpleExpression;
                case op of
                    eqOp:
                        eValue := ord(eValue = seValue);
                    ltOp:
                        eValue := ord(eValue < seValue);
                    gtOp:
                        eValue := ord(eValue > seValue);
                    neOp:
                        eValue := ord(eValue <> seValue);
                    leOp:
                        eValue := ord(eValue <= seValue);
                    geOp:
                        eValue := ord(eValue >= seValue);
                end;
            end;
        GetBooleanExpression := eValue;
        PutTokenBack;
    end;


{$S}
{Routines from here to the end of the file go in the macro1 segment}

    procedure DoCapture;
    begin
        CaptureAndDisplayFrame;
        if ContinuousHistogram then
            ShowContinuousHistogram;
    end;


    procedure DoWait;
        var
            seconds: extended;
            SaveTicks: LongInt;
            str: str255;
            theEvent: EventRecord;
    begin
        GetLeftParen;
        seconds := GetExpression;
        GetRightParen;
        if Token <> DoneT then begin
                SaveTicks := TickCount + round(seconds * 60.0);
                repeat
                    if Digitizing then
                        DoCapture;
                    if EventAvail(everyEvent, theEvent) then
                        ; {Allows background tasks to run}
                until (TickCount > SaveTicks) or CommandPeriod;
            end;
    end;


    procedure SetDensitySlice; {LowerLevel,UpperLevel:integer}
  {Disable density slicing if lower and upper=0 and enable it up lower and upper=255}
        var
            sStart, sEnd: integer;
    begin
        GetLeftParen;
        sStart := GetInteger;
        RangeCheck(sStart);
        GetComma;
        sEnd := GetInteger;
        RangeCheck(sEnd);
        GetRightParen;
        if Token <> DoneT then begin
                DisableDensitySlice;
                DisableThresholding;
                if (sEnd < sStart) or ((sStart = 0) and (sEnd = 0)) then
                    exit(SetDensitySlice);
                if not ((sStart = 255) and (sEnd = 255)) then begin
                        SliceStart := sStart;
                        SliceEnd := sEnd;
                        if SliceStart < 1 then
                            SliceStart := 1;
                        if SliceEnd > 254 then
                            SliceEnd := 254;
                    end;
                EnableDensitySlice;
            end;
    end;


    procedure SetColor;
        var
            index: integer;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        index := GetInteger;
        GetRightParen;
        RangeCheck(index);
        if Token <> DoneT then begin
                if SaveCommand = SetForeC then
                    SetForegroundColor(index)
                else
                    SetBackgroundColor(index);
            end;
    end;


    procedure DoConstantArithmetic;
        var
            constant: extended;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        constant := GetExpression;
        GetRightParen;
        if token <> DoneT then
            case SaveCommand of
                AddConstC:
                    DoArithmetic(AddItem, constant);
                MulConstC:
                    DoArithmetic(MultiplyItem, constant);
            end;
    end;


    procedure GetNextWindow;
        var
            n: integer;
    begin
        n := info^.PicNum + 1;
        if n > nPics then
            n := 1;
        StopDigitizing;
        SaveRoi;
        DisableDensitySlice;
        SelectWindow(PicWindow[n]);
        Info := pointer(WindowPeek(PicWindow[n])^.RefCon);
        ActivateWindow;
        GenerateValues;
        LoadLUT(info^.cTable);
        UpdatePicWindow;
    end;


    procedure DoRevert;
    begin
        if info^.revertable then begin
                RevertToSaved;
                UpdatePicWindow;
            end
        else
            MacroError('Unable to revert');
    end;


    procedure MakeRoi;
        var
            Left, Top, Width, Height: integer;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        left := GetInteger;
        GetComma;
        top := GetInteger;
        GetComma;
        width := GetInteger;
        if width < 1 then
            width := 1;
        GetComma;
        height := GetInteger;
        if height < 1 then
            height := 1;
        GetRightParen;
        KillRoi;
        if token <> DoneT then
            with Info^ do begin
                    StopDigitizing;
                    if SaveCommand = MakeOvalC then
                        RoiType := OvalRoi
                    else
                        RoiType := RectRoi;
                    SetRect(RoiRect, left, top, left + width, top + height);
                    MakeRegion;
                    SetupUndo;
                    RoiShowing := true;
                end;
    end;


    procedure MoveRoi;
        var
            DeltaH, DeltaV: integer;
    begin
        GetLeftParen;
        DeltaH := GetInteger;
        GetComma;
        DeltaV := GetInteger;
        GetRightParen;
        with info^ do begin
                if not RoiShowing then begin
                        MacroError('No Selection');
                        exit(MoveRoi);
                    end;
                OffsetRgn(roiRgn, DeltaH, DeltaV);
                RoiRect := roiRgn^^.rgnBBox;
            end;
    end;


    procedure InsetRoi;
        var
            delta: integer;
    begin
        GetLeftParen;
        delta := GetInteger;
        GetRightParen;
        with info^ do begin
                if not RoiShowing then begin
                        MacroError('No Selection');
                        exit(InsetRoi);
                    end;
                InsetRgn(roiRgn, delta, delta);
                RoiRect := roiRgn^^.rgnBBox;
            end;
    end;


    procedure DoMoveTo; {(x,y:integer)}
    begin
        GetLeftParen;
        CurrentX := GetInteger;
        GetComma;
        CurrentY := GetInteger;
        GetRightParen;
        InsertionPoint.h := CurrentX;
        InsertionPoint.v := CurrentY + 4;
    end;


    procedure DoDrawtext (str: str255; EndOfLine: boolean);
    begin
        if info <> NoInfo then begin
                KillRoi;
                DrawTextString(str, InsertionPoint, TextJust);
                if EndOfLine then begin
                        CurrentY := CurrentY + CurrentSize;
                        InsertionPoint.h := CurrentX;
                        InsertionPoint.v := CurrentY + 4;
                    end;
            end;
    end;


    procedure DrawNumber;
        var
            n: extended;
            str: str255;
            fwidth: integer;
    begin
        GetLeftParen;
        n := GetExpression;
        GetRightParen;
        if token <> DoneT then begin
                if n = trunc(n) then
                    fwidth := 0
                else
                    fwidth := precision;
                RealToString(n, 1, fwidth, str);
                DoDrawText(str, true);
            end;
    end;


    procedure SetFont;
        var
            FontName: str255;
            id: integer;
    begin
        FontName := GetStringArg;
        if Token <> DoneT then begin
                GetFNum(FontName, id);
                if id = 0 then
                    MacroError('Font not available')
                else
                    CurrentFontID := id;
            end;
    end;


    procedure SetFontSize;
        var
            size: integer;
    begin
        GetLeftParen;
        Size := GetInteger;
        GetRightParen;
        if (size < 6) or (size > 720) then
            MacroError('Argument out of range');
        if Token <> DoneT then
            CurrentSize := size;
    end;


    procedure SetText;
        var
            Attributes: str255;
    begin
        Attributes := GetStringArg;
        if Token <> DoneT then begin
                MakeLowerCase(Attributes);
                if pos('with', Attributes) <> 0 then
                    TextBack := WithBack;
                if pos('no', Attributes) <> 0 then
                    TextBack := NoBack;
                if pos('left', Attributes) <> 0 then
                    TextJust := teJustLeft;
                if pos('center', Attributes) <> 0 then
                    TextJust := teJustCenter;
                if pos('right', Attributes) <> 0 then
                    TextJust := teJustRight;
                CurrentStyle := [];
                if pos('bold', Attributes) <> 0 then
                    CurrentStyle := CurrentStyle + [Bold];
                if pos('italic', Attributes) <> 0 then
                    CurrentStyle := CurrentStyle + [Italic];
                if pos('underline', Attributes) <> 0 then
                    CurrentStyle := CurrentStyle + [Underline];
                if pos('outline', Attributes) <> 0 then
                    CurrentStyle := CurrentStyle + [Outline];
                if pos('shadow', Attributes) <> 0 then
                    CurrentStyle := CurrentStyle + [Shadow];
            end;
    end;


    procedure DoPutMessage;
        var
            str: str255;
    begin
        GetArguments(str);
        if Token <> DoneT then
            PutMessage(str)
    end;


    function GetVar: integer;
    begin
        GetVar := 0;
        GetToken;
        if token <> Variable then
            MacroError('Variable expected')
        else
            GetVar := TokenStackLoc;
    end;


    procedure GetPicSize;  {(width,height)}
        var
            loc1, loc2: integer;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^ do
                if info = NoInfo then begin
                        stack[loc1].value := 0.0;
                        stack[loc2].value := 0.0;
                    end
                else
                    with info^ do begin
                            stack[loc1].value := PixelsPerLine;
                            stack[loc2].value := nLines;
                        end;
    end;


    procedure GetRoi;  {(hloc,vloc,width,height)}
        var
            loc1, loc2, loc3, loc4: integer;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetComma;
        loc3 := GetVar;
        GetComma;
        loc4 := GetVar;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^, Info^ do
                if RoiShowing then
                    with RoiRect do begin
                            stack[loc1].value := left;
                            stack[loc2].value := top;
                            stack[loc3].value := right - left;
                            stack[loc4].value := bottom - top;
                        end
                else begin
                        stack[loc1].value := 0.0;
                        stack[loc2].value := 0.0;
                        stack[loc3].value := 0.0;
                        stack[loc4].value := 0.0;
                    end;
    end;


    procedure CaptureOneFrame;
    begin
        if FrameGrabber = noFrameGrabber then
            MacroError('Frame grabber not installed')
        else begin
                StartDigitizing;
                CaptureAndDisplayFrame;
                StopDigitizing;
            end;
    end;


    procedure DoMakeNewWindow; {(name:str255)}
        var
            name: str255;
    begin
        GetArguments(name);
        if token <> DoneT then
            if (NewPicWidth * NewPicHeight) > UndoBufSize then
                MacroError('New window larger than Undo buffer')
            else if not NewPicWindow(name, NewPicWidth, NewPicHeight) then
                MacroError('Out of memory');
    end;


    procedure DoSetPalette;
        var
            PaletteType: str255;
            ok, OptionalArgument: boolean;
            nExtra: LongInt;
    begin
        GetLeftParen;
        PaletteType := GetString;
        GetToken;
        OptionalArgument := token <> RightParen;
        PutTokenBack;
        if OptionalArgument then begin
                GetComma;
                nExtra := GetInteger;
                if nExtra < 0 then
                    nExtra := 0;
                if nExtra > 6 then
                    nExtra := 6;
        end;
        GetRightParen;
        if token <> DoneT then begin
                MakeLowerCase(PaletteType);
                if pos('gray', PaletteType) <> 0 then
                    ResetGrayMap
                else if pos('pseudo', PaletteType) <> 0 then
                    SwitchColorTables(Pseudo20Item, true)
                else if pos('system', PaletteType) <> 0 then
                    SwitchColorTables(SystemPaletteItem, true)
                else if pos('rainbow', PaletteType) <> 0 then
                    SwitchColorTables(RainbowItem, true)
                else if pos('spectrum', PaletteType) <> 0 then
                    SwitchColorTables(SpectrumItem, true);
                if OptionalArgument then begin
                    nExtraColors := nExtra;
                    RedrawLUTWindow;
                end;
            end;
    end;


    procedure DoOpenImage;
        var
            err: OSErr;
            f: integer;
            FileFound, result: boolean;
            fname: str255;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetArguments(fname);
        if token <> DoneT then begin
                if fname = '' then
                    fname := DefaultFileName;
                err := fsopen(fname, DefaultRefNum, f);
                FileFound := err = NoErr;
                err := fsclose(f);
                if FileFound then
                    case SaveCommand of
                        OpenC:
                            result := DoOpen(fname, DefaultRefNum);
                        ImportC:
                            result := ImportFile(fname, DefaultRefNum);
                    end
                else
                    case SaveCommand of
                        OpenC:
                            result := DoOpen('', 0);
                        ImportC:
                            result := ImportFile('', 0);
                    end;
                if result then
                    UpdatePicWindow
                else
                    token := DoneT;
            end;
    end;


    procedure SetImportAttributes;
        var
            Attributes: str255;
    begin
        Attributes := GetStringArg;
        if Token <> DoneT then begin
                MakeLowerCase(Attributes);
                WhatToImport := ImportTIFF;
                ImportCustomDepth := EightBits;
                ImportSwapBytes := false;
                ImportCalibrate := false;
                ImportAll := false;
                ImportAutoScale := true;
                ImportInvert := false;
                if pos('dicom', Attributes) <> 0 then
                    WhatToImport := ImportDICOM;
                if pos('mcid', Attributes) <> 0 then
                    WhatToImport := ImportMCID;
                if pos('look', Attributes) <> 0 then
                    WhatToImport := ImportLUT;
                if pos('palette', Attributes) <> 0 then
                    WhatToImport := ImportLUT;
                if pos('text', Attributes) <> 0 then
                    WhatToImport := ImportText;
                if pos('custom', Attributes) <> 0 then
                    WhatToImport := ImportCustom;
                if (pos('8', Attributes) <> 0) or (pos('eight', Attributes) <> 0) then begin
                        ImportCustomDepth := EightBits;
                        WhatToImport := ImportCustom;
                    end;
                if (pos('signed', Attributes) <> 0) then begin
                        ImportCustomDepth := SixteenBitsSigned;
                        WhatToImport := ImportCustom;
                    end;
                if (pos('unsigned', Attributes) <> 0) then begin
                        ImportCustomDepth := SixteenBitsUnsigned;
                        WhatToImport := ImportCustom;
                    end;
                if (pos('swap', Attributes) <> 0) then
                    ImportSwapBytes := true;
                if (pos('calibrate', Attributes) <> 0) then
                    ImportCalibrate := true;
                if (pos('fixed', Attributes) <> 0) then
                    ImportAutoScale := false;
                if (pos('all', Attributes) <> 0) then
                    ImportAll := true;
                if (pos('invert', Attributes) <> 0) then
                    ImportInvert := true;
            end;
    end;


    procedure SetImportMinMax; {(min,max:integer)}
        var
            TempMin, TempMax: extended;
    begin
        GetLeftParen;
        TempMin := GetExpression;
        GetComma;
        TempMax := GetExpression;
        GetRightParen;
        if Token <> DoneT then begin
                ImportAutoScale := false;
                ImportMin := TempMin;
                ImportMax := TempMax;
            end;
    end;


    procedure SetCustomImport; {(width,height,offset[,nslices]:integer)}
        var
            width, height, nSlices: integer;
            offset: LongInt;
    begin
        GetLeftParen;
        width := GetInteger;
        GetComma;
        height := GetInteger;
        GetComma;
        offset := GetInteger;
        GetToken;
        if token = comma then
            nSlices := GetInteger
        else begin
                PutTokenBack;
                nSlices := 1
            end;
        GetRightParen;
        if (width < 0) or (width > MaxPicSize) or (height < 0) or (offset < 0) or (nSlices < 1) or (nSlices > MaxSlices) then
            MacroError('Argument out of range');
        if Token <> DoneT then begin
                ImportCustomWidth := width;
                ImportCustomHeight := height;
                ImportCustomOffset := offset;
                ImportCustomSlices := nSlices;
                WhatToImport := ImportCustom;
            end;
    end;


    procedure SelectImage (id: integer);
    begin
        StopDigitizing;
        SaveRoi;
        DisableDensitySlice;
        SelectWindow(PicWindow[id]);
        Info := pointer(WindowPeek(PicWindow[id])^.RefCon);
        ActivateWindow;
        GenerateValues;
        LoadLUT(info^.cTable);
        UpdatePicWindow;
    end;


    procedure SelectPic; {(PicN:integer)}
        var
            PicN, i: integer;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        PicN := GetInteger;
        GetRightParen;
        i := 0;
        while (PicN < 0) and (i < nPics) do begin
                i := i + 1;
                if InfoPtr(WindowPeek(PicWindow[i])^.RefCon)^.pidNum = PicN then
                    PicN := i;
            end;
        if (PicN < 1) or (PicN > nPics) then
            MacroError('Specified image does not exist');
        if Token <> DoneT then begin
                if SaveCommand = SelectPicC then
                    SelectImage(PicN)
                else begin
                        StopDigitizing;
                        DisableDensitySlice;
                        Info := pointer(WindowPeek(PicWindow[PicN])^.RefCon);
                    end;
            end;
    end;


    procedure SetPicName;  {(name:string)}
        var
            n, i: LongInt;
            isInteger: boolean;
            name: str255;
    begin
        GetArguments(name);
        if Token <> DoneT then begin
                with info^ do begin
                        title := name;
                        if PictureType <> FrameGrabberType then
                            PictureType := NewPicture;
                        UpdateWindowsMenuItem;
                        UpdateTitleBar;
                    end;
            end;
    end;


    procedure SetNewSize; {(width,height:integer)}
        var
            TempWidth, TempHeight: integer;
    begin
        GetLeftParen;
        TempWidth := GetInteger;
        GetComma;
        TempHeight := GetInteger;
        GetRightParen;
        if Token <> DoneT then begin
                NewPicWidth := TempWidth;
                NewPicHeight := TempHeight;
                if NewPicWidth > MaxPicSize then
                    NewPicWidth := MaxPicSize;
                if NewPicWidth < 8 then
                    NewPicWidth := 8;
                if NewPicHeight < 1 then
                    NewPicHeight := 1;
                if NewPicHeight > MaxPicSize then
                    NewPicHeight := MaxPicSize;
            end;
    end;


    procedure DoSaveAs;
        var
            name: str255;
            RefNum: integer;
            HasArgs: boolean;
    begin
        name := info^.title;
        if (name = 'Untitled') or (name = 'Camera') then
            name := '';
        GetToken;
        HasArgs := token = LeftParen;
        PutTokenBack;
        if HasArgs then
            GetArguments(name);
        if token <> DoneT then begin
                StopDigitizing;
                if nSaves = 0 then
                    RefNum := 0
                else
                    RefNum := DefaultRefNum;
                case CurrentWindow of
                    TextKind:
                        if pos(':', name) <> 0 then
                            SaveTextUsingPath(name)
                        else
                            SaveTextAs;
                    ResultsKind:
                        Export('', RefNum);
                    otherwise begin
                            if info <> NoInfo then
                                SaveAs(name, RefNum)
                            else
                                MacroError(NoImageOpen);
                        end;
                end;
                nSaves := nSaves + 1;
            end;
    end;


    procedure DoSave;
        var
            kind: integer;
    begin
        StopDigitizing;
        kind := CurrentWindow;
        if (kind = PicKind) or (kind = TextKind) or (Kind = ResultsKind) then
            SaveFile
        else
            MacroError('Nothing to save');
    end;


    procedure DoExport;
        var
            name: str255;
            RefNum: integer;
            HasArgs: boolean;
    begin
        StopDigitizing;
        name := info^.title;
        if (name = 'Untitled') or (name = 'Camera') then
            name := '';
        GetToken;
        HasArgs := token = LeftParen;
        PutTokenBack;
        if HasArgs then
            GetArguments(name);
        if nSaves = 0 then
            RefNum := 0
        else
            RefNum := DefaultRefNum;
        Export(name, RefNum);
        nSaves := nSaves + 1;
    end;


    procedure DoCopyResults;
        var
            IgnoreResult: boolean;
    begin
        if mCount < 1 then
            MacroError('Copy Results failed')
        else begin
                CopyResults;
                IgnoreResult := SystemEdit(3); {Fake Copy needed for MultiFinder}
            end;
    end;


    procedure DisposeAll;
        var
            i, ignore: integer;
    begin
        StopDigitizing;
        for i := nPics downto 1 do begin
                Info := pointer(WindowPeek(PicWindow[i])^.RefCon);
                ignore := CloseAWindow(info^.wptr);
            end;
    end;


    procedure DoDuplicate;
        var
            str: str255;
    begin
        GetArguments(str);
        if token <> DoneT then
            if not Duplicate(str, false) then
                token := DoneT
            else
                UpdatePicWindow;
    end;


    procedure DoLineTo; {(x,y:integer)}
        var
            x, y: integer;
            p1, p2: point;
    begin
        GetLeftParen;
        p2.h := GetInteger;
        GetComma;
        p2.v := GetInteger;
        GetRightParen;
        if token <> DoneT then begin
                KillRoi;
                p1.h := CurrentX;
                p1.v := CurrentY;
                CurrentX := p2.h;
                CurrentY := p2.v;
                OffscreenToScreen(p1);
                OffscreenToScreen(p2);
                DrawObject(LineObj, p1, p2);
            end;
    end;


    procedure DoGetLine;  {(var x1,y1,x2,y2:real; LineWidth:integer)}
        var
            loc1, loc2, loc3, loc4, loc5: integer;
            x1, y1, x2, y2: extended;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetComma;
        loc3 := GetVar;
        GetComma;
        loc4 := GetVar;
        GetComma;
        loc5 := GetVar;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^, info^ do begin
                    GetLoi(x1, y1, x2, y2);
                    if RoiShowing and (RoiType = LineRoi) then
                        stack[loc1].value := x1
                    else
                        stack[loc1].value := -1;
                    stack[loc2].value := y1;
                    stack[loc3].value := x2;
                    stack[loc4].value := y2;
                    stack[loc5].value := LineWidth;
                end;
    end;


    procedure DoScaleAndRotate; {(hscale,vscale,angle:real)}
        var
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        rsHScale := GetExpression;
        GetComma;
        rsVScale := GetExpression;
        if SaveCommand <> ScaleSelectionC then begin
                GetComma;
                rsAngle := GetExpression;
            end;
        GetRightParen;
        if token <> DoneT then begin
                if SaveCommand = ScaleSelectionC then begin
                        rsMethod := NearestNeighbor;
                        rsCreateNewWindow := false;
                        rsAngle := 0.0;
                    end;
                ScaleAndRotate;
            end;
    end;


    procedure SetPlotScale; {(min,max:integer)}
        var
            min, max: extended;
    begin
        GetLeftParen;
        min := GetExpression;
        GetComma;
        max := GetExpression;
        GetRightParen;
        if info^.fit = uncalibrated then begin
                RangeCheck(trunc(min));
                RangeCheck(trunc(max));
            end;
        if token <> DoneT then begin
                AutoScalePlots := (min = 0.0) and (max = 0.0);
                ProfilePlotMin := min;
                ProfilePlotMax := max;
            end;
    end;


    procedure SetPlotDimensions; {(width,height:integer)}
        var
            width, height: integer;
    begin
        GetLeftParen;
        width := GetInteger;
        GetComma;
        height := GetInteger;
        GetRightParen;
        if token <> DoneT then begin
                FixedSizePlot := not ((width = 0) and (height = 0));
                ProfilePlotWidth := width;
                ProfilePlotHeight := height;
            end;
    end;


    procedure GetResults;  {(var n,mean,mode,min,max:real)}
        var
            loc1, loc2, loc3, loc4, loc5: integer;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetComma;
        loc3 := GetVar;
        GetComma;
        loc4 := GetVar;
        GetComma;
        loc5 := GetVar;
        GetRightParen;
        if mCount = 0 then
            MacroError('No results');
        if Token <> DoneT then
            with MacrosP^, results do begin
                    stack[loc1].value := PixelCount^[mCount];
                    stack[loc2].value := UncalibratedMean;
                    stack[loc3].value := imode;
                    stack[loc4].value := MinIndex;
                    stack[loc5].value := MaxIndex;
                end;
    end;


    procedure DoPasteOperation;
    begin
        if not (OpPending and (CurrentOp = PasteOp)) then begin
                MacroError('Not pasting');
                exit(DoPasteOperation);
            end;
        if MacroCommand in [AddC, SubC, MulC, DivC] then begin
                case MacroCommand of
                    AddC:
                        CurrentOp := AddOp;
                    SubC:
                        CurrentOp := SubtractOp;
                    MulC:
                        CurrentOp := MultiplyOp;
                    DivC:
                        CurrentOp := DivideOp;
                end;
                DoPasteMath;
                exit(DoPasteOperation);
            end;
        SetForegroundColor(BlackIndex);
        SetBackGroundColor(WhiteIndex);
        case MacroCommand of
            CopyModeC:
                SetPasteMode(CopyModeItem);
            AndC:
                SetPasteMode(AndItem);
            OrC:
                SetPasteMode(OrItem);
            XorC:
                SetPasteMode(XorItem);
            ReplaceC:
                SetPasteMode(ReplaceItem);
            BlendC:
                SetPasteMode(BlendItem);
        end;
        if OptionKeyWasDown then begin
                if PasteControl <> nil then
                    DrawPasteControl;
            end
        else
            KillRoi;
    end;


    procedure SetWidth; {(width:integer)}
        var
            width: integer;
    begin
        GetLeftParen;
        width := GetInteger;
        GetRightParen;
        if (Token <> DoneT) and (width > 0) then begin
                LineWidth := width;
                ShowLIneWidth;
            end;
    end;


    function GetMType (index: integer): MeasurementTypes;
    begin
        case index of
            0:
                GetMType := AreaM;
            1:
                GetMType := MeanM;
            2:
                GetMType := StdDevM;
            3:
                GetMType := xyLocM;
            4:
                GetMType := ModeM;
            5:
                GetMType := LengthM;
            6:
                GetMType := MajorAxisM;
            7:
                GetMType := MinorAxisM;
            8:
                GetMType := AngleM;
            9:
                GetMType := IntDenM;
            10:
                GetMType := MinMaxM;
            11:
                GetMType := User1M;
            12:
                GetMType := User2M;
        end;
    end;


    procedure SetPrecision; {(DigitsRightofDecimalPoint[,FieldWidth]:integer)}
        var
            digits, width: LongInt;
    begin
        GetLeftParen;
        digits := GetInteger;
        GetToken;
        if token = comma then
            width := GetInteger
        else
            PutTokenBack;
        GetRightParen;
        if Token <> DoneT then begin
                if (digits >= 0) and (digits <= 12) then
                    precision := digits;
                if (width >= 1) and (width <= 18) then
                    FieldWidth := width;
            end;
    end;


    procedure SetParticleSize; {(min,max:LongInt)}
        var
            min, max: LongInt;
    begin
        GetLeftParen;
        min := GetInteger;
        GetComma;
        max := GetInteger;
        GetRightParen;
        if Token <> DoneT then begin
                MinParticleSize := min;
                MaxParticleSize := max;
            end;
    end;


    procedure SetThreshold; {(level:integer)}
        var
            level: LongInt;
    begin
        GetLeftParen;
        level := GetInteger;
        GetRightParen;
        if level = -1 then begin
                DisableThresholding;
                exit(SetThreshold);
            end;
        RangeCheck(level);
        if Token <> DoneT then
            EnableThresholding(level);
    end;


    procedure DrawPixel (h, v, value: integer);
  {Draws a pixel on the screen in the current foreground color.}
    begin
        SetPort(info^.wptr);
        PenNormal;
        SetFColor(value);
        PenSize(1, 1);
        MoveTo(h, v);
        LineTo(h, v);
    end;


    procedure DoPutPixel; {(hloc,vloc, value:integer)}
        var
            hloc, vloc: LongInt;
            value: integer;
            MaskRect: rect;
    begin
        GetLeftParen;
        hloc := GetInteger;
        GetComma;
        vloc := GetInteger;
        GetComma;
        value := GetInteger;
        GetRightParen;
        if (Token <> DoneT) and (info <> NoInfo) then begin
                KillRoi;
                PutPixel(hloc, vloc, value);
                if info^.magnification = 1.0 then
                    DrawPixel(hloc, vloc, value)
                else begin
                    SetRect(MaskRect, hloc, vloc, hloc + 1, vloc + 1);
                    UpdateScreen(MaskRect);
                end;
                info^.changes := true;
            end;
    end;


    procedure CloseWindow;
        var
            OldPicNum, NewPicNum, ignore: integer;
    begin
        if CurrentWindow <> PicKind then begin
                ignore := CloseAWindow(CurrentWPtr);
                exit(CloseWindow);
            end;
        if info = NoInfo then begin
                MacroError(NoImageOpen);
                exit(CloseWindow);
            end;
        StopDigitizing;
        SaveRoi;
        with info^ do begin
                OldPicNum := PicNum;
                ignore := CloseAWindow(wptr);
            end;
        if nPics >= 1 then begin
                NewPicNum := OldPicNum - 1;
                if NewPicNum < 1 then
                    NewPicNum := 1;
                SelectImage(NewPicNum);
            end;
    end;


    procedure SetScaling;
        var
            ScalingOptions: str255;
            ok: boolean;
    begin
        ScalingOptions := GetStringArg;
        if token <> DoneT then begin
                MakeLowerCase(ScalingOptions);
                rsInteractive := false;
                if pos('bilinear', ScalingOptions) <> 0 then
                    rsMethod := Bilinear;
                if pos('nearest', ScalingOptions) <> 0 then
                    rsMethod := NearestNeighbor;
                if pos('new', ScalingOptions) <> 0 then
                    rsCreateNewWindow := true;
                if pos('same', ScalingOptions) <> 0 then
                    rsCreateNewWindow := false;
                if pos('interactive', ScalingOptions) <> 0 then
                    rsInteractive := true;
            end;
    end;


    procedure DoChangeValues; {(v1,v2,v3:integer)}
        var
            v1, v2, v3: integer;
    begin
        GetLeftParen;
        v1 := GetInteger;
        GetComma;
        v2 := GetInteger;
        GetComma;
        v3 := GetInteger;
        GetRightParen;
        RangeCheck(v1);
        RangeCheck(v2);
        RangeCheck(v3);
        if Token <> DoneT then
            ChangeValues(v1, v2, v3);
    end;


    procedure DoGetMouse;  {(var x,y:integer)}
        var
            loc1, loc2, sh, sv: integer;
            loc: point;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^ do begin
                    SetPort(info^.wptr);
                    GetMouse(loc);
                    with loc do begin
                            sh := h;
                            sv := v;
                            ScreenToOffscreen(loc);
                            if sh < 0 then
                                h := sh;
                            if sv < 0 then
                                v := sv;
                            stack[loc1].value := h;
                            stack[loc2].value := v;
                        end;
                end;
    end;


    procedure DoRotate (cmd: CommandType);
        var
            NoBoolean, NewWindow: boolean;
    begin
        GetToken;
        noBoolean := token <> LeftParen;
        PutTokenBack;
        if NoBoolean then
            NewWindow := false
        else
            NewWindow := GetBooleanArg;
        if NewWindow then begin
                case cmd of
                    RotateRC:
                        RotateToNewWindow(RotateRight);
                    RotateLC:
                        RotateToNewWindow(RotateLeft)
                end;
                if not macro then
                    MacroError('Rotate failed')
            end
        else
            case cmd of
                RotateRC:
                    FlipOrRotate(RotateRight);
                RotateLC:
                    FlipOrRotate(RotateLeft)
            end;
    end;


    procedure DoSelectSlice; {(SliceNumber:integer)}
        var
            SliceNumber: LongInt;
            isRoi: boolean;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        SliceNumber := GetInteger;
        GetRightParen;
        with info^, info^.StackInfo^ do begin
                if (SliceNumber < 1) or (SliceNumber > nSlices) then
                    MacroError('Illegal slice number');
                if Token <> DoneT then begin
                        isRoi := RoiShowing;
                        if isRoi then
                            KillRoi;
                        CurrentSlice := SliceNumber;
                        SelectSlice(CurrentSlice);
                        if SaveCommand = SelectSliceC then begin
                                UpdatePicWindow;
                                UpdateTitleBar;
                            end;
                        if isRoi then
                            RestoreRoi;
                    end;
            end;
    end;


    procedure MakeNewStack; {(name:str255)}
        var
            name: str255;
            aok: boolean;
    begin
        GetArguments(name);
        if token <> DoneT then
            if (NewPicWidth * NewPicHeight) > UndoBufSize then
                MacroError('Stack larger than Undo Buffer')
            else if NewPicWindow(name, NewPicWidth, NewPicHeight) then
                if not MakeStackFromWindow then
                    MacroError('Out of memory');
    end;


    procedure MakeLineRoi; {(x1,y1,x2,y2:real)}
        var
            x1, y1, x2, y2: extended;
    begin
        GetLeftParen;
        x1 := GetExpression;
        GetComma;
        y1 := GetExpression;
        GetComma;
        x2 := GetExpression;
        GetComma;
        y2 := GetExpression;
        GetRightParen;
        if token <> DoneT then
            with Info^ do begin
                    KillRoi;
                    StopDigitizing;
                    LX1 := x1;
                    LY1 := y1;
                    LX2 := x2;
                    LY2 := y2;
                    RoiType := LineRoi;
                    MakeRegion;
                    SetupUndo;
                    RoiShowing := true;
                end;
    end;


    procedure DoGetTime;
        var
            date: DateTimeRec;
            loc1, loc2, loc3, loc4, loc5, loc6, loc7: integer;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetComma;
        loc3 := GetVar;
        GetComma;
        loc4 := GetVar;
        GetComma;
        loc5 := GetVar;
        GetComma;
        loc6 := GetVar;
        GetComma;
        loc7 := GetVar;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^, info^ do begin
                    GetTime(date);
                    with date do begin
                            stack[loc1].value := year;
                            stack[loc2].value := month;
                            stack[loc3].value := day;
                            stack[loc4].value := hour;
                            stack[loc5].value := minute;
                            stack[loc6].value := second;
                            stack[loc7].value := DayOfWeek;
                        end;
                end;
    end;


    function GetStringVar: integer;
    begin
        GetStringVar := 0;
        GetToken;
        if token <> StringVariable then
            MacroError('String variable expected')
        else
            GetStringVar := TokenStackLoc;
    end;


    procedure DoSetScale; {(scale:real; unit:string; [AspectRatio: real])}
        var
            id: integer;
            scale, AspectRatio: extended;
            str: str255;
    begin
        AspectRatio:=0.0;
        GetLeftParen;
        scale := GetExpression;
        GetComma;
        str := GetString;
        GetToken;
        if token=comma
            then AspectRatio:=GetExpression
            else PutTokenBack;
        GetRightParen;
        if token <> DoneT then
            with info^ do begin
                    if str = '' then begin
                            SetScale; {Display Set Scale dialog box}
                            exit(DoSetScale);
                        end;
                    if scale < 0.0 then begin
                            MacroError('Scale<0');
                            exit(DoSetScale);
                        end;
                    MakeLowerCase(str);
                    TruncateString(str, maxUnit);
                    xUnit := str;
                    xScale := scale;
                    yScale := scale;
                    if AspectRatio>0.0 then begin
                        PixelAspectRatio:=AspectRatio;
                        yScale := xScale / PixelAspectRatio;
                    end else
                        PixelAspectRatio := 1.0;
                    SpatiallyCalibrated := (xUnit <> '') and (xUnit <> 'pixel') and (xUnit <> 'pixels') and (xScale <> 0.0);
                    UpdateTitleBar;
                end;
    end;


    procedure GetScale;  {(var scale:real; unit:string; [AspectRatio:real])}
        var
            loc1, loc2, loc3, index, count: integer;
            str: str255;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetStringVar;
        loc3:=0;
        GetToken;
        if token=comma
         then loc3 := GetVar
         else PutTokenBack;
        GetRightParen;
        if Token <> DoneT then
            with info^, MacrosP^ do
                if SpatiallyCalibrated then begin
                        stack[loc1].value := xScale;
                        stack[loc2].StringH^^ := xUnit;
                        if loc3>0 then stack[loc3].value := PixelAspectRatio;
                    end
                else begin
                        stack[loc1].value := 1.0;
                        stack[loc2].StringH^^ := 'pixel';
                        if loc3>0 then stack[loc3].value := 1.0;
                    end;
    end;


    procedure SaveState;
    begin
        SaveForeground := ForegroundIndex;
        SaveBackground := BackgroundIndex;
        SavePicWidth := NewPicWidth;
        SavePicHeight := NewPicHeight;
        SaveMethod := rsMethod;
        SaveCreate := rsCreateNewWindow;
        SaveAngle := rsAngle;
        SaveH := rsHScale;
        SaveV := rsVScale;
        SaveInvertY := InvertYCoordinates;
        SaveScaleArithmetic := ScaleArithmetic;
        SaveScaleConvolutions := ScaleConvolutions;
        SaveCurrentFontID:=CurrentFontID;
        SaveCurrentSize:=CurrentSize;
        SaveCurrentStyle:=CurrentStyle;
        SaveTextJust:=TextJust;
        SaveTextBack:=TextBack;
    end;


    procedure RestoreState;
    begin
        if SaveForeground = -1 then
            MacroError('State not saved')
        else begin
                SetForegroundColor(SaveForeground);
                SetBackgroundColor(SaveBackground);
                NewPicWidth := SavePicWidth;
                NewPicHeight := SavePicHeight;
                rsMethod := SaveMethod;
                rsCreateNewWindow := SaveCreate;
                rsAngle := SaveAngle;
                rsHScale := SaveH;
                rsVScale := SaveV;
                InvertYCoordinates := SaveInvertY;
                ScaleArithmetic := SaveScaleArithmetic;
                ScaleConvolutions := SaveScaleConvolutions;
                CurrentFontID:=SaveCurrentFontID;
                CurrentSize:=SaveCurrentSize;
                CurrentStyle:=SaveCurrentStyle;
                TextJust:=SaveTextJust;
                TextBack:=SaveTextBack;
end;
    end;


    procedure DoPrint;
    begin
        FindWhatToPrint;
        if WhatToPrint <> NothingToPrint then
            Print(false)
        else
            MacroError('NothingToPrint');
    end;


    procedure SetCounter; {(n:integer)}
        var
            N, i: LongInt;
    begin
        GetLeftParen;
        N := GetInteger;
        GetRightParen;
        if (N < 0) or (N > MaxMeasurements) then
            MacroError('Argument out of range');
        if Token <> DoneT then begin
                if N = 0 then
                    ResetCounter;
                for i := mCount + 1 to N do
                    ClearResults(i);
                mCount := N;
                UpdateList;
                ShowInfo;
            end;
    end;


    procedure OutputText;
        var
            NewLine: boolean;
            str: str255;
            i: integer;
            SaveCommand: CommandType;
    begin
        NewLine := MacroCommand <> WriteC;
        SaveCommand := MacroCommand;
        GetArguments(str);
        if token <> DoneT then begin
                if SaveCommand = ShowMsgC then begin
                        for i := 1 to length(str) do
                            if str[i] = '\' then
                                str[i] := cr;
                        InfoMessage := str;
                        ShowInfo;
                    end
                else begin
                        if CurrentWindow = TextKind then begin
                            InsertText(str, NewLine);
                            if not macro then MacroError('32K text limit exceeded')
                        end else
                            DoDrawText(str, NewLine);
                    end;
            end;
    end;


    procedure SetErosionDilationCount; {(n:integer)}
        var
            n: LongInt;
    begin
        GetLeftParen;
        n := GetInteger;
        GetRightParen;
        if (n < 1) or (n > 8) then
            MacroError('Argument out of range');
        if Token <> DoneT then begin
                BinaryCount := n;
                BinaryThreshold := BinaryCount * 255;
            end;
    end;


    procedure SetSliceSpacing; {(n:real)}
        var
            n: extended; {pixels}
    begin
        GetLeftParen;
        n := GetExpression;
        GetRightParen;
        if (n <= 0.0) or (n > 100.0) then
            MacroError('Argument out of range');
        if info^.StackInfo = nil then
            MacroError('No stack');
        if Token <> DoneT then
            info^.StackInfo^.SliceSpacing := n;
    end;


    procedure GetOrPutLineOrColumn;  {(x,y,count:integer:integer)}
        var
            x, y, count, i: integer;
            MaskRect: rect;
            aLine2: LineType;
            SaveCommand: CommandType;
    begin
        SaveCommand := MacroCommand;
        GetLeftParen;
        x := GetInteger;
        GetComma;
        y := GetInteger;
        GetComma;
        count := GetInteger;
        GetRightParen;
        if (Token <> DoneT) and (count <= MaxLine) then
            with MacrosP^ do begin
                    KillRoi;
                    case SaveCommand of
                        GetRowC:
                            GetLine(x, y, count, aLine);
                        PutRowC:  begin
                                PutLine(x, y, count, aLine);
                                SetRect(MaskRect, x, y, x + count, y + 1);
                                UpdateScreen(MaskRect);
                                info^.changes := true;
                            end;
                        GetColumnC:
                            GetColumn(x, y, count, aLine);
                        PutColumnC:  begin
                                PutColumn(x, y, count, aLine);
                                SetRect(MaskRect, x, y, x + 1, y + count);
                                UpdateScreen(MaskRect);
                                info^.changes := true;
                            end;
                    end; {case}
                end;
    end;


    procedure CheckVersion; {(RequiredVersion:real)}
        var
            RequiredVersion: extended;
            str: str255;
    begin
        GetLeftParen;
        RequiredVersion := GetExpression;
        GetRightParen;
        if (Token <> DoneT) then
            if round(RequiredVersion * 100.0) > version then begin
                    RealToString(RequiredVersion, 1, 2, str);
                    PutError(concat('This macro requires version ', str, ' or later of NIH Image.'));
                    Token := DoneT;
                end;
    end;


    procedure SetOptions; {(Options:string)}
        var
            options: str255;
            mtype: MeasurementTypes;
            i, LastOption: integer;
            SaveMeasurements: SetOfMeasurements;
    begin
        GetLeftParen;
        Options := GetString;
        GetRightParen;
        if (Token <> DoneT) then begin
                SaveMeasurements := measurements;
                MakeLowerCase(options);
                Measurements := [];
                if pos('area', options) <> 0 then
                    Measurements := Measurements + [AreaM];
                if pos('mean', options) <> 0 then
                    Measurements := Measurements + [MeanM];
                if pos('st', options) <> 0 then
                    Measurements := Measurements + [StdDevM];
                if pos('center', options) <> 0 then
                    Measurements := Measurements + [xyLocM];
                if pos('mode', options) <> 0 then
                    Measurements := Measurements + [ModeM];
                if (pos('per', options) <> 0) or (pos('length', options) <> 0) then
                    Measurements := Measurements + [LengthM];
                if pos('major', options) <> 0 then
                    Measurements := Measurements + [MajorAxisM];
                if pos('minor', options) <> 0 then
                    Measurements := Measurements + [MinorAxisM];
                if pos('angle', options) <> 0 then
                    Measurements := Measurements + [AngleM];
                if pos('int', options) <> 0 then
                    Measurements := Measurements + [IntDenM];
                if pos('max', options) <> 0 then
                    Measurements := Measurements + [MinMaxM];
                if pos('1', options) <> 0 then
                    Measurements := Measurements + [User1M];
                if pos('2', options) <> 0 then
                    Measurements := Measurements + [User2M];
                UpdateFitEllipse;
                if Measurements <> SaveMeasurements then
                    UpdateList;
            end;
    end;


    procedure SetLabel;
        var
            SaveCommand: CommandType;
            str, SaveLabel: str255;
    begin
        SaveCommand := MacroCommand;
        GetArguments(str);
        TruncateString(str, maxLabelLength);
        case SaveCommand of
            SetMajorC:  begin
                    SaveLabel := MajorLabel;
                    MajorLabel := str;
                    Measurements := Measurements + [MajorAxisM];
                end;
            SetMinorC:  begin
                    SaveLabel := MinorLabel;
                    MinorLabel := str;
                    Measurements := Measurements + [MinorAxisM];
                end;
            SetUser1C:  begin
                    SaveLabel := User1Label;
                    User1Label := str;
                    Measurements := Measurements + [User1M];
                end;
            SetUser2C:  begin
                    SaveLabel := User2Label;
                    User2Label := str;
                    Measurements := Measurements + [User2M];
                end;
        end; {case}
        ShowInfo;
        if str <> SaveLabel then
            UpdateList;
    end;


    procedure DoUpdateLUT;
    begin
        with info^ do begin
            SetupPseudocolor;
            LutMode := PseudoColor;
            IdentityFunction := false;
            if isGrayScaleLUT then
                info^.LutMode := CustomGrayScale;
            UpdateLut;
            UpdateMap;
        end;
    end;


    procedure SubtractBackground; {(Options:string; BallRadius:integer)}
        var
            options: str255;
            radius, item: integer;
    begin
        GetLeftParen;
        Options := GetString;
        GetComma;
        radius := GetInteger;
        GetRightParen;
        if (Token <> DoneT) then begin
                MakeLowerCase(options);
                FasterBackgroundSubtraction := pos('faster', options) <> 0;
                item := Sub2DItem;
                if pos('hor', options) <> 0 then
                    item := HorizontalItem;
                if pos('ver', options) <> 0 then
                    item := VerticalItem;
                if pos('roll', options) <> 0 then
                    item := Sub2DItem;
                if pos('remove', options) <> 0 then
                    item := RemoveStreaksItem;
            end;
        BallRadius := Radius;
        if Radius < 1 then
            BallRadius := 1;
        if Radius > 319 then
            BallRadius := 319;
        DoBackgroundMenuEvent(Item);
    end;


    procedure SetExportMode;
        var
            mode: str255;
    begin
        mode := GetStringArg;
        if Token <> DoneT then begin
                MakeLowerCase(mode);
                ExportAsWhat := AsRaw;
                if pos('mcid', mode) <> 0 then
                    ExportAsWhat := asMCID;
                if pos('text', mode) <> 0 then
                    ExportAsWhat := asText;
                if pos('lut', mode) <> 0 then
                    ExportAsWhat := asLUT;
                if pos('meas', mode) <> 0 then
                    ExportAsWhat := asMeasurements;
                if pos('plot', mode) <> 0 then
                    ExportAsWhat := asPlotValues;
                if pos('hist', mode) <> 0 then
                    ExportAsWhat := asHistogramValues;
                if pos('xy', mode) <> 0 then
                    ExportAsWhat := asCoordinates;
            end;
    end;


    procedure SetSaveAsMode;
        var
            mode: str255;
    begin
        mode := GetStringArg;
        if Token <> DoneT then begin
                MakeLowerCase(mode);
                SaveAsWhat := asTiff;
                if pos('tiff', mode) <> 0 then
                    SaveAsWhat := asTiff;
                if pos('pict', mode) <> 0 then
                    SaveAsWhat := asPict;
                if pos('quick', mode) <> 0 then
                    SaveAsWhat := asQuickTime;
                if pos('pics', mode) <> 0 then
                    SaveAsWhat := asPICS;
                if pos('lut', mode) <> 0 then
                    SaveAsWhat := AsPalette;
                if pos('outline', mode) <> 0 then
                    SaveAsWhat := AsOutline;
                if pos('rgb', mode) <> 0 then with info^ do begin
                    if StackInfo = nil then begin
                        MacroError('Stack required');
                        exit(SetSaveAsMode);
                    end;
                    if StackInfo^.nSlices <> 3 then begin
                        MacroError('Stack must have 3 slices');
                        exit(SetSaveAsMode);
                    end;
                    StackInfo^.StackType := rgbStack;
                    UpdateTitleBar;
                end;
            end;
    end;


    procedure MoveCurrentWindow;{(x,y:integer)}
        var
            x, y: integer;
            ignore: integer;
            fwptr: WindowPtr;
            kind: integer;
    begin
        GetLeftParen;
        x := GetInteger;
        GetComma;
        y := GetInteger;
        GetRightParen;
        fwptr := FrontWindow;
        if fwptr <> nil then begin
                kind := WindowPeek(fwptr)^.WindowKind;
                if (kind = PicKind) or (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) or (kind = HistoKind) or (Kind = PasteControlKind) or (Kind = ResultsKind) or (Kind = TextKind) then
                    MoveWindow(fwptr, x, y, true);
            end;
    end;


    procedure DoUserCode; {str:str255; Param1,Param2,Param3:real;}
  {Contributed by Mark Vivino}
        var
            WhichCode: integer;
            Param1, Param2, Param3: extended;
            str: str255;
            NewVersion: boolean;
    begin
        GetLeftParen;
        GetToken;
        NewVersion := (token = StringLiteral) or (token = StringVariable);
        PutTokenBack;
        WhichCode := 0;
        str := '';
        if NewVersion then
            str := GetString
        else
            WhichCode := GetInteger;
        GetComma;
        Param1 := GetExpression;
        GetComma;
        Param2 := GetExpression;
        GetComma;
        Param3 := GetExpression;
        GetRightParen;
        if Token <> DoneT then begin
                if NewVersion then
                    UserMacroCode(str, Param1, Param2, Param3)
                else begin
                        if (WhichCode < 1) or (WhichCode > 10) then
                            MacroError('Range error . Allowable range is 1 to 10.');
                        OldUserMacroCode(WhichCode, Param1, Param2, Param3);
                    end;
            end;
    end;


    procedure CloseSerialPorts;
        var
            err: OSErr;
    begin
        if SerialBufferP <> nil then begin
                err := CloseDriver(SerialOut);
                err := CloseDriver(SerialIn);
                DisposePtr(SerialBufferP);
            end;
    end;


    procedure OpenSerial;
        const
            SerialBufferSize = 1024;
        var
            err: OSErr;
            baud, data, stop, parity, i: integer;
            config: integer;
            flags: SerShk;
            str: str255;
    begin
        CloseSerialPorts;
        baud := baud9600;
        data := data8;
        stop := stop10;
        parity := noParity;
        str := GetStringArg;
        if token = DoneT then
            exit(OpenSerial);
        MakeLowerCase(str);
        if pos('300', str) <> 0 then
            baud := baud300;
        if pos('1200', str) <> 0 then
            baud := baud1200;
        if pos('2400', str) <> 0 then
            baud := baud2400;
        if pos('19200', str) <> 0 then
            baud := baud19200;
        if pos('two', str) <> 0 then
            stop := stop20;
        if pos('seven', str) <> 0 then
            data := data7;
        i:=pos('even', str);
        if (i <> 0) and (str[i-1]<>'s') then
            parity := evenParity;
        if pos('odd', str) <> 0 then
            parity := oddParity;
        if (OpenDriver('.AOut', SerialOut) <> NoErr) or (OpenDriver('.AIn', SerialIn) <> NoErr) then begin
                MacroError('Error opening modem port');
                exit(OpenSerial);
            end;
        SerialBufferP := NewPtr(SerialBufferSize);
        if SerialBufferP = nil then begin
                MacroError('Out of Memory');
                exit(OpenSerial);
            end;
        with flags do begin
                fXOn := ord(false); {Disable xon/xoff output flow control}
                fCTS := ord(false); {Disable CTS (output) flow control}
                xOn := chr(17);
                xOff := chr(19);
                errs := 0;
                evts := 0;
                fInX := ord(true);  {Enable xon/xoff input flow control}
                fDTR := ord(true); {Enable DTR (input) flow control}
            end;
        Config := baud + data + stop + parity;
        Err := SerHShake(SerialOut, flags);
        Err := SerSetBuf(SerialIn, SerialBufferP, SerialBufferSize);
        Err := SerReset(SerialOut, Config);
    end;


    procedure PutSerial;
        var
            i: integer;
            Size: LongInt;
            OutputBuffer: packed array[1..256] of char;
            str: str255;
            err: OSErr;
    begin
        GetArguments(str);
        if token = DoneT then
            exit(PutSerial);
        if SerialBufferP = nil then begin
                MacroError('Serial port not open');
                exit(PutSerial);
            end;
        Size := 0;
        for i := 1 to length(str) do begin
                size := size + 1;
                OutputBuffer[size] := str[i];
            end;
        if size > 0 then
            err := fswrite(SerialOut, size, @OutputBuffer);
    end;


    procedure DoSetCursor; {str: string}
        var
            str: str255;
    begin
        str := GetStringArg;
        if Token <> DoneT then begin
                MakeLowerCase(str);
                if pos('watch', str) <> 0 then
                    SetCursor(watch);
                if pos('cross', str) <> 0 then
                    SetCursor(ToolCursor[SelectionTool]);
                if pos('arrow', str) <> 0 then
                    InitCursor;
                if pos('finger', str) <> 0 then
                    SetCursor(FingerCursor);
            end;
    end;


    procedure SetVideoOptions; {options: string[, gain:integer, offset:integer]}
        var
            options: str255;
            NewSyncMode: SyncModeType;
      gain, offset: integer;

        procedure SetOption (id: integer; var option: boolean; enable: boolean);
    {Updates the modeless Video Control dialog box.}
        begin
            if option <> enable then
                DoVideoControl(id)
        end;

    begin
        GetLeftParen;
        options := GetString;
        GetToken;
        if token = comma then begin
            gain := GetInteger;
            GetComma;
            offset := GetInteger
        end
        else begin
            PutTokenBack;
            gain := 255 - (DacHigh - DacLow);
            offset := DacLow;
        end;
        GetRightParen;
        if Token <> DoneT then begin
                MakeLowerCase(options);
                SetOption(InvertID, InvertVideo, pos('invert', options) <> 0);
                SetOption(HighlightID, HighlightSaturatedPixels, pos('high', options) <> 0);
                SetOption(TriggerID, ExternalTrigger, pos('trig', options) <> 0);
                if pos('sep', options) <> 0 then
                    NewSyncMode := SeparateSync
                else
                    NewSyncMode := NormalSync;
                if NewSyncMode <> SyncMode then
                    DoVideoControl(SyncID);
                SetOffset(offset, gain);
                SetGain(offset, gain);
                if VideoControl <> nil then begin
                    gain := 255 - (DacHigh - DacLow);
                    ShowOffsetAndGain(DacLow, gain);
                end;
                OscillatingMovies := pos('osc', options) <> 0;
                BlindMovieCapture := pos('blind', options) <>0;
                if (FrameGrabber = ScionLG3) or (FrameGrabber=ScionAG5) or (FrameGrabber=ScionVG5f) then begin
                        DacLowReg^ := DacLow;
                        DacHighReg^ := DacHigh;
                    end;
            end;
    end;


    procedure SetChannel; {(channel:integer)}
        var
            channel: integer;
    begin
        GetLeftParen;
        channel := GetInteger;
        GetRightParen;
        if (channel < 1) or (channel > 4) then
            MacroError('Bad channel number')
        else
            DoVideoControl(FirstChannelID + channel - 1);
    end;


    procedure DoAcquire;
        var
            fname: str255;
    begin
        fname := GetStringArg;
        LoadAcqPlugIn(fname);
    end;


    procedure CallExportPlugin;
        var
            fname: str255;
    begin
        fname := GetStringArg;
        LoadExportPlugIn(fname);
    end;


    procedure CallFilterPlugin;
        var
            fname: str255;
    begin
        fname := GetStringArg;
        LoadFilterPlugIn(fname);
    end;


    procedure DoPhotoMode;
        var
            erase: boolean;
    begin
        erase := GetBooleanArg;
        if Token <> DoneT then begin
                if erase then begin
                        EraseScreen;
                        UpdatePicWindow;
                        InPhotoMode := true;
                    end
                else if InPhotoMode then
                        RestoreScreen;
            end;
    end;


    procedure RGBToIndexed; {options: string}
        var
            options: str255;
    begin
        options := GetStringArg;
        if Token <> DoneT then begin
                MakeLowerCase(options);
                RGBLut := CustomLUT;
                DitherColor := false;
                if pos('exist', options) <> 0 then
                    RGBLut := ExistingLUT;
                if pos('system', options) <> 0 then
                    RGBLut := SystemLUT;
                if pos('dither', options) <> 0 then
                    DitherColor := true;
                ConvertRGBToEightBitColor(false);
            end;
    end;


 procedure DoAverageFrames; {[(Options:string; nFrames:integer)]}
  var
   options: str255;
   nFrames: LongInt;
   HasArguments,ShowDialog,okay: boolean;
 begin
  GetToken;
  HasArguments := token = LeftParen;
  PutTokenBack;
  ShowDialog:=false;
  if HasArguments then begin
    GetLeftParen;
    Options := GetString;
    GetComma;
    nFrames := GetInteger;
    ShowDialog:= nFrames <= 0;
    if not ShowDialog then
        FramesToAverage := nFrames;
    GetRightParen;
    if (Token <> DoneT) then begin
      MakeLowerCase(options);
      VideoRateAveraging := false;
      SumFrames := false;
      IntegrateOnChip := false;
      if (pos('int', options) <> 0) or (pos('sum', options) <> 0) then
       sumFrames := true;
      if pos('video', options) <> 0 then
       VideoRateAveraging := true;
      if (pos('camera', options) <> 0) or (pos('chip', options) <> 0) then begin
       if  (FrameGrabber<>ScionLG3) and (FrameGrabber<>ScionAG5) and (FrameGrabber<>ScionVG5f) then begin
         MacroError('On-chip integration requires a Scion frame grabber.');
         exit(DoAverageFrames)
       end;
       VideoRateAveraging := false;
       SumFrames := false;
       IntegrateOnChip := true;
       end;
     end;
   end; {has arguments}
  if token <> DoneT then begin
   if ShowDialog
    then okay:=DoAveragingOptions
    else okay:=true;
   if okay then AverageFrames;
  end;
 end;


    procedure DoSelectWindow;{('str')}
        var
            str, wTitle: str255;
            WPeek, NextWPeek: WindowPeek;
            id: integer;
            TempInfo: InfoPtr;
    begin
        GetArguments(str);
        MakeLowerCase(str);
        if Token <> DoneT then begin
                wPeek := WindowPeek(FrontWindow);
                while wPeek <> nil do begin
                        NextWPeek := wPeek^.NextWindow;
                        if wPeek^.WindowKind = PicKind then begin
                                TempInfo := InfoPtr(wPeek^.RefCon);
                                wTitle := TempInfo^.title;
                            end
                        else
                            wTitle := wPeek^.TitleHandle^^;
                        MakeLowerCase(wTitle);
                        if str = wTitle then begin
                                if wPeek^.WindowKind = PicKind then begin
                                        info := InfoPtr(wPeek^.RefCon);
                                        with info^ do
                                            if (PicNum >= 1) and (PicNum <= nPics) then
                                                SelectImage(PicNum);
                                    end
                                else
                                    SelectWindow(WindowPtr(wPeek));
                                leave;
                            end;
                        wpeek := NextWPeek;
                    end;
                if wPeek = nil then
                    MacroError('Window not found');
            end;
    end;


    procedure GetThreshold;  {(lower,upper)}
        var
            loc1, loc2: integer;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^ do
                with info^ do begin
                        if Thresholding then begin
                                stack[loc1].value := ColorStart;
                                stack[loc2].value := 255;
                            end
                        else if DensitySlicing then begin
                                stack[loc1].value := SliceStart;
                                stack[loc2].value := SliceEnd;
                            end
                        else begin
                                stack[loc1].value := 0;
                                stack[loc2].value := 0;
                            end;
                    end;
    end;


    procedure SortPalette;
        type
            MyHSVColor = record
                    lHue, lSaturation, lValue: LongInt;
                end;
            HSVRec = record
                    index: integer;
                    hsv: MyHSVColor;
                end;
            HSVArrayType = array[0..255] of HSVRec;
        var
            TempTable: MyCSpecArray;
            i: integer;
            HSVArray: HSVArrayType;
            h, s, v: LongInt;
            fHue, fSaturation, fValue: fixed;
            TempHSV: HSVColor;
            table: LookupTable;

        procedure SortByHue;
    {Selection sorts from "Algorithms" by Robert Sedgewick.}
            var
                i, j, min: integer;
                t: HSVRec;
        begin
            for i := 1 to 254 do begin
                    min := i;
                    for j := i + 1 to 254 do
                        if HSVArray[j].hsv.lHue < HSVArray[min].hsv.lHue then
                            min := j;
                    t := HSVArray[min];
                    HSVArray[min] := HSVArray[i];
                    HSVArray[i] := t;
                end;
        end;

    begin
        ShowWatch;
        DisableDensitySlice;
        with info^ do begin
                for i := 1 to 254 do begin
                        HSVArray[i].index := i;
                        rgb2hsv(cTable[i].rgb, TempHSV);
                        with TempHSV do begin
                                fHue := SmallFract2Fix(hue);
                                fSaturation := SmallFract2Fix(saturation);
                                fValue := SmallFract2Fix(value);
                            end;
                        with HSVArray[i].hsv do begin
                                lHue := ord4(band(fHue, $ffff));
                                lSaturation := ord4(band(fSaturation, $ffff));
                                lValue := ord4(band(fValue, $ffff));
                            end;
                    end;
                SortByHue;
                for i := 1 to 254 do
                    TempTable[i].rgb := cTable[HSVArray[i].index].rgb;
                cTable := TempTable;
                LoadLUT(cTable);
                if info <> NoInfo then begin
                        table[0] := 0;
                        table[255] := 255;
                        for i := 1 to 254 do
                            table[HSVArray[i].index] := i;
                        ApplyTable(table);
                    end;
                WhatToUndo := NothingToUndo;
                SetupPseudocolor;
                ColorTable := CustomTable;
            end; {with}
    end;


    procedure DoProject;
    begin
        if info^.StackInfo = nil then begin
            MacroError('Stack required');
            exit(DoProject);
        end;
        if not ((ProjectC in RoutinesCalled) or (SetProjectionC in RoutinesCalled)) then begin
                if ShowProjectDialogBox then
                    DoProjection
                else
                    token := DoneT;
            end
        else with info^.StackInfo^ do begin
            if SliceSpacing <= 0.0 then
                SliceSpacing := 1.0;
            if DensitySlicing then
                with info^ do begin
                        TransparencyLower := SliceStart;
                        TransparencyUpper := SliceEnd;
                    end;
            DoProjection;
        end;
        RoutinesCalled := RoutinesCalled + [ProjectC];
    end;


    procedure DoNewTextWindow; {(name,width,height)}
        var
            str: str255;
            okay, OptionalArguments: boolean;
            width, height: LongInt;
    begin
        GetLeftParen;
        str := GetString;
        GetToken;
        OptionalArguments := token <> RightParen;
        PutTokenBack;
        width := 500;
        height := 400;
        if OptionalArguments then begin
                GetComma;
                width := GetInteger;
                if width < 8 then
                    width := 8;
                GetComma;
                height := GetInteger;
                if height < 8 then
                    height := 8;
            end;
        GetRightParen;
        if Token <> DoneT then
            okay := MakeNewTextWindow(str, width, height);
    end;


    procedure ImageMath; {('op',pic1,pic2,gain,offset,'result')}
        var
            op, result: str255;
            pic1, pic2, DstPidNum: LongInt;
            gain, offset: extended;
            roi:rect;
            DstInfo:InfoPtr;
            isPidNum:boolean;
    begin
        GetLeftParen;
        op := GetString;
        GetComma;
        pic1 := GetInteger;
        GetComma;
        pic2 := GetInteger;
        GetComma;
        gain := GetExpression;
        GetComma;
        offset := GetExpression;
        GetComma;
        GetToken;
        isPidNum:=token=variable;
        PutTokenBack;
        if isPidNum
            then DstPidNum:=GetInteger
            else result := GetString;
        GetRightParen;
        if token <> DoneT then begin
                MakeLowerCase(op);
                RealImageMath:=false;
                if pos('calibrate', op) <> 0 then
                    RealImageMath := true;
                if pos('real', op) <> 0 then
                    RealImageMath := true;
                if pos('add', op) <> 0 then
                    CurrentMathOp := AddMath;
                if pos('sub', op) <> 0 then
                    CurrentMathOp := SubMath;
                if pos('mul', op) <> 0 then
                    CurrentMathOp := MulMath;
                if (pos('cmul', op) <> 0) or (pos('conjugate', op) <> 0) then begin
                    CurrentMathOp := cMulMath;
                    RealImageMath := true;
                end;
                if pos('div', op) <> 0 then
                    CurrentMathOp := DivMath;
                if pos('and', op) <> 0 then
                    CurrentMathOp := AndMath;
                if pos('or', op) <> 0 then
                    CurrentMathOp := OrMath;
                if pos('xor', op) <> 0 then
                    CurrentMathOp := XorMath;
                if pos('max', op) <> 0 then
                    CurrentMathOp := MaxMath;
                if pos('min', op) <> 0 then
                    CurrentMathOp := MinMath;
                if pos('copy', op) <> 0 then
                    CurrentMathOp := CopyMath;
                MathGain := gain;
                MathOffset := offset;
                if not GetMathRoi(pic1, pic2, roi) then
                    exit(ImageMath);
                if isPidNum then begin
                    DstInfo := GetInfoPtr(DstPidNum);
                    if DstInfo=nil then begin
                        MacroError('Bad pid number');
                        exit(ImageMath);
                    end;
                    if RealImageMath and (DstInfo^.dataH = nil) then begin
                        MacroError('Real output image required');
                        exit(ImageMath);
                    end;
                    SelectWindow(DstInfo^.wptr);
                    Info := DstInfo;
                    ActivateWindow;
                    LoadLUT(info^.cTable);
                    UpdatePicWindow;
                    KillRoi;
                end else begin
                    with roi do
                        if RealImageMath then begin
                            if not NewRealWindow(result, right-left, bottom-top) then
                                exit(ImageMath)
                        end else begin
                            if not NewPicWindow(result, right-left, bottom-top) then
                                exit(ImageMath)
                        end;
                    DstInfo := Info;
                end;
                DoMath(pic1, pic2, DstInfo, roi);
            end;
    end;


    procedure PasteLive;
    begin
        with info^ do begin
                if not RoiShowing or (RoiType <> RectRoi) then begin
                        MacroError('No selection');
                        exit(PasteLive);
                    end;
                if PictureType = FrameGrabberType then begin
                        MacroError('Can''t paste into Camera window');
                        exit(PasteLive);
                    end;
                if FrameGrabber = NoFrameGrabber then begin
                        MacroError('No frame grabber');
                        exit(PasteLive);
                    end;
                if (RoiRect.right > fgwidth) or (RoiRect.bottom > fgheight) then begin
                        MacroError('Selection out of range');
                        exit(PasteLive);
                    end;
                SetupUndo;
                WhatToUndo := UndoPaste;
                ClipBufInfo^.RoiRect := RoiRect;
                OpPending := true;
                CurrentOp := PasteOp;
                LivePasteMode := true;
                WhatsOnClip := LivePic;
            end;{with}
    end;


    procedure GetPlotData;  {(var nValues,PixelsPerValue, Min,Max:real)}
        var
            loc1, loc2, loc3, loc4: integer;
    begin
        GetLeftParen;
        loc1 := GetVar;
        GetComma;
        loc2 := GetVar;
        GetComma;
        loc3 := GetVar;
        GetComma;
        loc4 := GetVar;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^, results do begin
                    ShowPlot := false;
                    PlotDensityProfile;
                    ShowPlot := true;
                    stack[loc1].value := PlotCount;
                    stack[loc2].value := PlotAvg;
                    stack[loc3].value := ActualPlotMin;
                    stack[loc4].value := ActualPlotMax;
                end;
    end;


    procedure DoDelete;  {(var dest; index, count:integer)}
        var
            StackLoc, index, count: integer;
            str: str255;
    begin
        GetLeftParen;
        StackLoc := GetStringVar;
        str := TokenStr;
        GetComma;
        index := GetInteger;
        GetComma;
        count := GetInteger;
        GetRightParen;
        if Token <> DoneT then
            with MacrosP^.stack[StackLoc] do begin
                    delete(str, index, count);
                    if StringH <> nil then
                        StringH^^ := str;
                end;
    end;


    procedure DoAutoOutline;  {(x,y:integer)}
        var
            x, y: integer;
            start: point;
    begin
        GetLeftParen;
        x := GetInteger;
        GetComma;
        y := GetInteger;
        GetRightParen;
        if Token <> DoneT then begin
                start.h := x;
                start.v := y;
                AutoOutline(start);
            end;
    end;


    procedure DoFilter; {(fType:string)}
        var
            fType: str255;
            doMore:boolean;
            t:FateTable;
    begin
        GetLeftParen;
        fType := GetString;
        GetRightParen;
        if token <> DoneT then begin
                MakeLowerCase(fType);
                doMore:=pos('more', fType) <> 0;
                if pos('smooth', fType) <> 0 then begin
                    if doMore then
                        Filter(UnweightedAvg, 0, t)
                    else
                        Filter(WeightedAvg, 0, t);
                    exit(DoFilter);
                end;
                if pos('sharpen', fType) <> 0 then begin
                    if doMore then
                        Filter(SharpenMore, 0, t)
                    else
                        Filter(fsharpen, 0, t);
                    exit(DoFilter);
                end;
                if pos('median', fType) <> 0 then begin
                    RankFilter := MedianRank;
                    DoRankFilter;
                    exit(DoFilter);
                end;
                if (pos('edges', fType) <> 0) or (pos('sobel', fType)<>0) then begin
                    Filter(FindEdges, 0, t);
                    exit(DoFilter);
                end;
                if pos('dither', fType) <> 0 then begin
                    Filter(Dither, 0, t);
                    exit(DoFilter);
                end;
                if pos('min', fType) <> 0 then begin
                    RankFilter := MinRank;
                    DoRankFilter;
                    exit(DoFilter);
                end;
                if pos('max', fType) <> 0 then begin
                    RankFilter := MaxRank;
                    DoRankFilter;
                    exit(DoFilter);
                end;
                MacroError('Undefined filter');
            end;
    end;


    procedure DoShadow; {[(Direction:string)]}
        var
            direction: str255;
            t: FateTable;
    begin
        GetToken;
        if token =LeftParen then begin
            direction := GetString;
            MakeLowerCase(direction);
            GetRightParen;
        end else begin
            PutTokenBack;
            direction:='se';
        end;
        if Token <> DoneT then
        if direction='n' then Filter(ShadowN, 0, t)
        else if direction='ne' then Filter(ShadowNE, 0, t)
        else if direction='e'  then Filter(ShadowE, 0, t)
        else if direction='se' then Filter(ShadowSE, 0, t)
        else if direction='s'  then Filter(ShadowS, 0, t)
        else if direction='sw' then Filter(ShadowSW, 0, t)
        else if direction='w'  then Filter(ShadowW, 0, t)
        else if direction='nw' then Filter(ShadowNW, 0, t)
        else MacroError('Invalid direction');
        end;


    procedure DoCalibrate; {(fit,unit:string,m1,k1,m2,k2,...)}
        var
            sFit, sUnit: str255;
            Measured, Known:StandardsArray;
            nPairs, i:integer;
    begin
        GetLeftParen;
        sFit := GetString;
        if token <> DoneT then with info^ do begin
                MakeLowerCase(sFit);
                if pos('straight', sFit) <> 0 then fit:=StraightLine
                else if pos('rodbard', sFit) <> 0 then fit:=RodbardFit
                else if pos('od', sFit) <> 0 then fit:=UncalibratedOD
                else if pos('uncal', sFit) <> 0 then fit:=Uncalibrated
                else if pos('exp', sFit) <> 0 then fit:=ExpoFit
                else if pos('log', sFit) <> 0 then fit:=LogFit
                else if pos('pow', sFit) <> 0 then fit:=PowerFit
                else if pos('poly2', sFit) <> 0 then fit:=Poly2
                else if pos('poly3', sFit) <> 0 then fit:=Poly3
                else if pos('poly4', sFit) <> 0 then fit:=Poly4
                else if pos('poly5', sFit) <> 0 then fit:=Poly5
                else begin
                    MacroError('Unknown fit');
                    exit(DoCalibrate);
                end;
                if (fit=Uncalibrated) or (fit=UncalibratedOD) then begin
                    GetRightParen;
                    Calibrate;
                    exit(DoCalibrate);
                end;
        end;
        GetComma;
        sUnit := GetString;
        GetComma;
        nPairs:=0;
        GetToken;
        while (token<>RightParen) and (token<>DoneT) do begin
            PutTokenBack;
            if nPairs<MaxStandards then
                nPairs:=nPairs+1;
            Measured[nPairs]:=GetExpression;
            GetComma;
            Known[nPairs]:=GetExpression;
            GetToken;
            if token=comma then
                GetToken;
        end;
        if token <> DoneT then with info^ do begin
                if nPairs<2 then begin
                    MacroError('More arguments expected');
                    exit(DoCalibrate);
                end;
                TruncateString(sUnit, maxUM);
                UnitOfMeasure:=sUnit;
                nStandards:=nPairs;
                nKnownValues:=nPairs;
                for i:=1 to nStandards do begin
                    ClearResults(i);
                    uMean[i]:=Measured[i];
                    Mean^[i]:=Measured[i];
                    StandardValues[i]:=Known[i];
                end;
                mCount := nStandards;
                UpdateList;
                Calibrate;
            end;
    end;


    procedure DoMakeMovie; {(Options:string; nFrames:integer; delay:extended)}
        var
            options: str255;
            nFrames: integer;
            delay: extended;
            ShowDialog: boolean;
    begin
            GetLeftParen;
            Options := GetString;
            GetComma;
            nFrames := GetInteger;
            GetComma;
            delay := GetExpression;
            GetRightParen;
            if (Token <> DoneT) then begin
                    ShowDialog := pos('dialog', options) <> 0;
                    if ShowDialog and (length(options) = 6) then begin
                        MakeMovie(true);
                        exit(DoMakeMovie);
                    end;
                    if nFrames > 0 then
                        FramesWanted := nFrames;
                    if delay >= 0.0 then
                        SecondsPerFrame := delay;
                    MakeLowerCase(options);
                    BlindMovieCapture := false;
                    LG3BufferCapture := false;
                    TriggerFirstFrameOnly := true;
                    TimeStamp := false;
                    UseExistingStack := false;
                    if pos('blind', options) <> 0 then
                        BlindMovieCapture := true;
                    if (pos('buffer', options) <> 0) then
                        LG3BufferCapture := true;
                    if (pos('stamp', options) <> 0) then
                            TimeStamp := true;
                    if (pos('trigger', options) <> 0) and (pos('first', options) <> 0) then begin
                        ExternalTrigger := true;
                        TriggerFirstFrameOnly := true;
                      end;
                    if (pos('trigger', options) <> 0) and (pos('each', options) <> 0) then begin
                        ExternalTrigger := true;
                        TriggerFirstFrameOnly := false;
                      end;
                    if (pos('existing', options) <> 0) then
                            UseExistingStack := true;
                    MakeMovie(ShowDialog);
                end;
    end;


    procedure DoAnalyzeParticles; {[(Options:string)]}
        var
            options: str255;
            hasOptions, okay: boolean;
    begin
        GetToken;
        hasOptions := token = LeftParen;
        PutTokenBack;
        if hasOptions then begin
            GetArguments(options);
            MakeLowerCase(options);
            if pos('dialog', options) <> 0 then begin
                okay := DoAPDialog;
                if okay then
                    AnalyzeParticles;
                exit(DoAnalyzeParticles);
            end;
            LabelParticles := false;
            OutlineParticles := false;
            IgnoreParticlesTouchingEdge := false;
            IncludeHoles := false;
            APReset := false;
            if pos('label', options) <> 0 then
                LabelParticles := true;
            if pos('outline', options) <> 0 then
                OutlineParticles := true;
            if pos('ignore', options) <> 0 then
                IgnoreParticlesTouchingEdge := true;
            if pos('include', options) <> 0 then
                IncludeHoles := true;
            if pos('reset', options) <> 0 then
                APReset := true;
        end;
        AnalyzeParticles;
    end;


  procedure SetProjection;
    var
      v: extended;
      s: str255;
  begin
    GetLeftParen;
    s := GetString;
        MakeLowerCase(s);
    if pos('x-axis', s) <> 0 then
      AxisOfRotation := XAxis
    else if pos('y-axis', s) <> 0 then
      AxisOfRotation := YAxis
    else if pos('z-axis', s) <> 0 then
      AxisOfRotation := ZAxis
    else if pos('nearest', s) <> 0 then
      ProjectionMethod := NearestPoint
    else if pos('brightest', s) <> 0 then
      ProjectionMethod := BrightestPoint
    else if pos('mean', s) <> 0 then
      ProjectionMethod := MeanValue
    else begin
        GetComma;
        if pos('save', s) <> 0 then
          SaveProjections := GetBoolean
        else if pos('minimize', s) <> 0 then
          MinProjSize := GetBoolean
        else begin
            v := GetExpression;
            if pos('initial', s) <> 0 then
              InitAngle := round(v)
            else if pos('total', s) <> 0 then
              TotalAngle := round(v)
            else if pos('increment', s) <> 0 then
              AngleInc := round(v)
            else if pos('opacity', s) <> 0 then
              Opacity := round(v)
            else if pos('surface', s) <> 0 then
              DepthCueSurf := 100 - round(v)
            else if pos('interior', s) <> 0 then
              DepthCueInt := 100 - round(v)
            else
              MacroError('String not recognized:');
          end;
      end;
    GetRightParen;
        RoutinesCalled := RoutinesCalled + [SetProjectionC];
  end;


    procedure DoGetHistogram;
        var
            Left, Top, Width, Height: integer;
            SaveRoiRect: rect;
    begin
        GetLeftParen;
        left := GetInteger;
        GetComma;
        top := GetInteger;
        GetComma;
        width := GetInteger;
        if width < 1 then
            width := 1;
        GetComma;
        height := GetInteger;
        if height < 1 then
            height := 1;
        GetRightParen;
        if token <> DoneT then
            with Info^ do begin
                    SaveRoiRect := RoiRect;
                    SetRect(RoiRect, left, top, left + width, top + height);
                    GetRectHistogram;
                    RoiRect := SaveRoiRect;
                end;
    end;


    procedure doFFTMacro; {(Options:string)}
        var
            options: str255;
    begin
        GetLeftParen;
        Options := GetString;
        GetRightParen;
        if (Token <> DoneT) then begin
                MakeLowerCase(options);
                if pos('foreward', options) <> 0 then
                    doFFT(ForewardFFT)
                else if pos('inverse', options) <> 0 then begin
                    if pos('without', options) <> 0 then
                        doFFT(InverseFFT)
                    else if pos('filter', options) <> 0 then
                        doFFT(InverseFFTWithFilter)
                    else doFFT(InverseFFTWithMask)
                end else if pos('display', options) <> 0 then
                    RedisplayPowerSpectrum
                else if pos('swap', options) <> 0 then
                    doSwapQuadrants
                else
                    MacroError('Unrecognized argument');
            end;
    end;


    procedure GetFileInfo; {(path: string, var type:string; var size: integer)}
    type
        CharArray = packed array[1..4] of char;
    var
        err: OSErr;
        path: str255;
        FinderInfo: FInfo;
        ftype: CharArray;
        loc1, loc2, f: integer;
        FileSize : LongInt;
    begin
        GetLeftParen;
        path := GetString;
        GetComma;
        loc1 := GetStringVar;
        GetComma;
        loc2 := GetVar;
        GetRightParen;
        if Token <> DoneT then with MacrosP^ do begin
            err := GetFInfo(path, 0, FinderInfo);
            if err = noErr then begin
                err := fsopen(path, 0, f);
                err := GetEOF(f, FileSize);
                if err = noErr then
                    stack[loc2].value := FileSize
                else
                    stack[loc2].value := -1;
                err := fsclose(f);
                fType := CharArray(FinderInfo.fdType);
                stack[loc1].StringH^^ := concat(ftype[1], ftype[2], ftype[3], ftype[4]);
            end else begin
                stack[loc1].StringH^^ := '';
                stack[loc2].value := -1;
            end;
        end;
    end;


    procedure DoSelectTool;
    var
        tType: str255;
    begin
        GetLeftParen;
        tType := GetString;
        GetRightParen;
        if token = DoneT then
            exit(DoSelectTool);
        MakeLowerCase(tType);
        PreviousTool := CurrentTool;
            {left side tools}
        if pos('magn', tType) <> 0 then
            CurrentTool := MagnifyingGlass
        else if pos('grabber', tType) <> 0 then
            CurrentTool := Grabber
        else if pos('pencil', tType) <> 0 then
            CurrentTool := Pencil
        else if pos('eraser', tType) <> 0 then
            CurrentTool := Eraser
        else if pos('brush', tType) <> 0 then
            CurrentTool := Brush
        else if pos('drawline', tType) <> 0 then
            CurrentTool := ruler
        else if pos('paint', tType) <> 0 then
            CurrentTool := PaintBucket
        else if pos('profile', tType) <> 0 then
            CurrentTool := PlotTool
        else if pos('wand', tType) <> 0 then
            CurrentTool := Wand
        else if pos('angletool', tType) <> 0 then
            CurrentTool := AngleTool
            {right side tools}
        else if pos('rect', tType) <> 0 then
            CurrentTool := SelectionTool
        else if pos('oval', tType) <> 0 then
            CurrentTool := OvalSelectionTool
        else if pos('poly', tType) <> 0 then
            CurrentTool := PolygonTool
        else if pos('freehand', tType) <> 0 then
            CurrentTool := FreehandTool
        else if pos('straight', tType) <> 0 then begin
            CurrentTool := LineTool;
            LOIType := Straight;
        end
        else if pos('freeline', tType) <> 0 then begin
            CurrentTool := LineTool;
            LOIType := Freehand;
        end
        else if pos('segment', tType) <> 0 then begin
            CurrentTool := LineTool;
            LOIType := Segmented;
        end
        else if pos('lut', tType) <> 0 then
            CurrentTool := LUTTool
        else if pos('text', tType) <> 0 then
            CurrentTool := TextTool
        else if pos('spray', tType) <> 0 then
            CurrentTool := SprayCanTool
        else if pos('picker', tType) <> 0 then
            CurrentTool := PickerTool
        else if pos('cross', tType) <> 0 then
            CurrentTool := CrossHairTool
        else begin
            MacroError('Unrecognized tool name');
            exit(DoSelectTool);
        end;
        isSelectionTool := (CurrentTool = SelectionTool) or (CurrentTool = OvalSelectionTool)
            or (CurrentTool = PolygonTool) or (CurrentTool = FreehandTool) or (CurrentTool = LineTool);
        DrawTools;
        if (not isSelectionTool) and (CurrentTool <> MagnifyingGlass) and
            (CurrentTool <> Grabber) and (CurrentTool <> Wand) then
                KillRoi;
        with info^ do if RoiShowing then
            if EqualRect(RoiRect, PicRect) and not isSelectionTool then {if Select All}
                KillRoi;
        if (CurrentTool = SelectionTool) or (CurrentTool = CrossHairTool) then begin
            InfoMessage := '';
            if mCount > 0 then
                ShowInfo;
        end;
        RoiMode := MoveMode;
        if CurrentTool = LineTool then
            if (LoiType = Straight) and (LineWidth <> 1) then begin
                LineWidth := 1;
                UpdateRoiLineWidth;
                ShowLineWidth;
        end;
    end;


    procedure DoExit;
    var
        reason: str255;
    begin
        GetToken;
        if token = LeftParen then begin
            reason := GetString;
            GetRightParen;
            beep;
            PutMessage(reason);
        end else
          PutTokenBack;
        token := DoneT;
    end;


    procedure DoBinary; {(op:string)}
        var
            op: str255;
    begin
        GetLeftParen;
        op := GetString;
        GetRightParen;
        if token <> DoneT then begin
                MakeLowerCase(op);
                if (pos('edm', op) <> 0) or (pos('map', op) <> 0) then begin
                    MakeEDM(EDMItem);
                    exit(DoBinary);
                end;
                if pos('ultimate', op) <> 0 then begin
                    MakeEDM(UltimateItem);
                    exit(DoBinary);
                end;
                if pos('watershed', op) <> 0 then begin
                    MakeEDM(WatershedItem);
                    exit(DoBinary);
                end;
                MacroError('Undefined binary operation');
            end;
    end;


      procedure DoAverageSlices;
    var
       FirstSlice, nSlices: LongInt;
        HasArguments: boolean;
    begin
        GetToken;
        HasArguments := token = LeftParen;
        PutTokenBack;
        FirstSlice := 0;
        nSlices := 0;
        if HasArguments then begin
            GetLeftParen;
            FirstSlice := GetInteger;
            GetComma;
            nSlices := GetInteger;
            GetRightParen;
        end;
        if (Token <> DoneT) then
            AverageSlices(FirstSlice, nSlices);
      end;


      procedure ExecuteCommand;
        var
            AutoSelectAll: boolean;
            t: FateTable;  {Needed for MakeSkeleton}
            okay: boolean;
            theEvent: EventRecord;
    begin
        if Info = NoInfo then
            if not (MacroCommand in LegalWithoutImage) then begin
                    MacroError('No image window active');
                    exit(ExecuteCommand);
                end;
        if DoOption then begin
                OptionKeyWasDown := true;
                DoOption := false;
            end;
        if OpPending then
            if not (MacroCommand in [CopyModeC, AndC, OrC, XorC, BlendC, ReplaceC, AddC, SubC, MulC, DivC, SetOptionC, PasteLiveC, GetRoiC, RequiresC, UndoC]) then begin
                    KillRoi; {Terminate any pending paste operation.}
                    RestoreRoi;
                end;
        case MacroCommand of
            RotateRC, RotateLC:
                DoRotate(MacroCommand);
            FlipVC:
                FlipOrRotate(FlipVertical);
            FlipHC:
                FlipOrRotate(FlipHorizontal);
            CopyC:  begin
                    FindWhatToCopy;
                    if WhatToCopy = NothingToCopy then
                        MacroError('Copy failed')
                    else
                        DoCopy;
                end;
            SelectC:
                if CurrentWindow = TextKind then
                    SelectAllText
                else begin
                    StopDigitizing;
                    SelectAll(true);
                end;
            PasteC:
                DoPaste;
            ClearC, FillC, InvertC, FrameC:
                with info^ do begin
                        AutoSelectAll := not RoiShowing;
                        if AutoSelectAll then
                            SelectAll(true);
                        case MacroCommand of
                            ClearC:
                                DoOperation(EraseOp);
                            FillC:
                                DoOperation(PaintOp);
                            InvertC:
                                DoOperation(InvertOp);
                            FrameC:
                                DoOperation(FrameOp);
                        end;
                        UpdateScreen(RoiRect);
                        if AutoSelectAll then
                            KillRoi;
                    end;
            KillC:
                KillRoi;
            RestoreC:
                if NoInfo^.RoiType <> NoRoi then
                    RestoreRoi;
            AnalyzeC:
                DoAnalyzeParticles;
            ConvolveC:
                DoConvolve;
            NextC:
                GetNextWindow;
            MarkC:
                MarkSelection(mCount);
            MeasureC:  begin
                    Measure;
                    InitCursor;
                end;
            MakeBinC:
                MakeBinary;
            DitherC:
                Filter(Dither, 0, t);
            SmoothC:
                if OptionKeyWasDown then
                    Filter(UnweightedAvg, 0, t)
                else
                    Filter(WeightedAvg, 0, t);
            SharpenC:
                Filter(fsharpen, 0, t);
            ShadowC:
                DoShadow;
            TraceC:
                Filter(EdgeDetect, 0, t);
            ReduceC:
                Filter(ReduceNoise, 0, t);
            RedirectC:
                RedirectSampling := GetBooleanArg;
            ThresholdC:
                SetThreshold;
            AutoThresholdC:
                AutoThreshold;
            ResetgmC:
                ResetGrayMap;
            WaitC:
                DoWait;
            ResetmC:
                ResetCounter;
            SetSliceC:
                SetDensitySlice;
            UndoC:
                DoUndo;
            SetForeC, SetBackC:
                SetColor;
            HistoC:  begin
                    DoHistogram;
                    DrawHistogram;
                end;
            EnhanceC:
                EnhanceContrast;
            EqualizeC:
                EqualizeHistogram;
            ErodeC:  begin
                    BinaryIterations := 1;
                    DoErosion;
                end;
            DilateC:  begin
                    BinaryIterations := 1;
                    DoDilation;
                end;
            OutlineC:
                filter(OutlineFilter, 0, t);
            ThinC:
                MakeSkeleton;
            AddConstC, MulConstC:
                DoConstantArithmetic;
            RevertC:
                DoRevert;
            BeepC:
                Beep;
            NopC:
                ;
            MakeC, MakeOvalC:
                MakeRoi;
            MoveC:
                MoveRoi;
            InsetC:
                InsetRoi;
            MoveToC:
                DoMoveTo;
            DrawTextC, WriteC, WritelnC, ShowMsgC:
                OutputText;
            SetFontC:
                SetFont;
            SetFontSizeC:
                SetFontSize;
            SetTextC:
                SetText;
            DrawNumC:
                DrawNumber;
            ExitC:
                DoExit;
            GetPicSizeC:
                GetPicSize;
            PutMsgC:
                DoPutMessage;
            GetRoiC:
                GetRoi;
            MakeNewC:
                DoMakeNewWindow;
            DrawScaleC:
                if info^.RoiShowing then begin
                        DrawScale;
                        UpdatePicWindow
                    end
                else
                    MacroError('No Selection');
            SetPaletteC:
                DoSetPalette;
            OpenC, ImportC:
                DoOpenImage;
            SetImportC:
                SetImportAttributes;
            SetMinMaxC:
                SetImportMinMax;
            SetCustomC:
                SetCustomImport;
            SelectPicC, ChoosePicC:
                SelectPic;
            SetPicNameC:
                SetPicName;
            ApplyLutC:
                ApplyLookupTable;
            SetSizeC:
                SetNewSize;
            SaveC:
                DoSave;
            SaveAllC:
                SaveAll;
            SaveAsC:
                DoSaveAs;
            CopyResultsC:
                DoCopyResults;
            CloseC, DisposeC:
                CloseWindow;
            DisposeAllC:
                DisposeAll;
            DupC:
                DoDuplicate;
            GetInfoC:
                GetInfo;
            PrintC:
                DoPrint;
            LineToC:
                DoLineTo;
            GetLineC:
                DoGetLine;
            ShowPasteC:
                if PasteControl = nil then
                    ShowPasteControl
                else
                    BringToFront(PasteControl);
            ChannelC:
                SetChannel;
            ColumnC, PlotProfileC:  begin
                    PlotDensityProfile;
                    if PlotWindow <> nil then
                        UpdatePlotWindow;
                end;
            ScaleC, ScaleSelectionC:
                DoScaleAndRotate;
            SetOptionC:
                DoOption := true;
            SetLabelsC:
                DrawPlotLabels := GetBooleanArg;
            SetPlotScaleC:
                SetPlotScale;
            SetDimC:
                SetPlotDimensions;
            GetResultsC:
                GetResults;
            CopyModeC, AndC, OrC, XorC, BlendC, ReplaceC, AddC, SubC, MulC, DivC:
                DoPasteOperation;
            ScaleMathC:
                ScaleArithmetic := GetBooleanArg;
            InvertYC:
                InvertYCoordinates := GetBooleanArg;
            SetWidthC:
                SetWidth;
            ShowResultsC:  begin
                    ShowResults;
                    UpdateList
                end;
            StartC:
                StartDigitizing;
            StopC:
                StopDigitizing;
            CaptureC:
                CaptureOneFrame;
            GetRowC, PutRowC, GetColumnC, PutColumnC:
                GetOrPutLineOrColumn;
            PlotXYZC:
                PlotXYZ;
            IncludeC:
                IncludeHoles := GetBooleanArg;
            AutoC:
                WandAutoMeasure := GetBooleanArg;
            LabelC:
                LabelParticles := GetBooleanArg;
            OutlineParticlesC:
                OutlineParticles := GetBooleanArg;
            IgnoreC:
                IgnoreParticlesTouchingEdge := GetBooleanArg;
            AdjustC:
                WandAdjustAreas := GetBooleanArg;
            SetParticleSizeC:
                SetParticleSize;
            SetPrecisionC:
                SetPrecision;
            PutPixelC:
                DoPutPixel;
            ScalingOptionsC:
                SetScaling;
            SetExportC:
                SetExportMode;
            ExportC:
                DoExport;
            ChangeC:
                DoChangeValues;
            UpdateResultsC:  begin
                    ShowInfo;
                    DeleteLines(mCount, mCount);
                    AppendResults;
                end;
            TileC:
                TileImages;
            SetMajorC, SetMinorC, SetUser1C, SetUser2C:
                SetLabel;
            GetMouseC:
                DoGetMouse;
            SelectSliceC, ChooseSliceC, AddSliceC, DeleteSliceC, ResliceC:  begin
                    if info^.StackInfo = nil then
                        MacroError('No stack');
                    if token <> DoneT then
                        case MacroCommand of
                            SelectSliceC, ChooseSliceC:
                                DoSelectSlice;
                            AddSliceC:
                                okay := AddSlice(true);
                            DeleteSliceC:
                                DeleteSlice;
                            ResliceC:
                                Reslice;
                        end;
                end;
            MakeStackC:
                MakeNewStack;
            AverageFramesC:
                DoAverageFrames;
            TriggerC:
                WaitForTrigger;
            MakeLineC:
                MakeLineRoi;
            GetTimeC:
                DoGetTime;
            SetScaleC:
                DoSetScale;
            SaveStateC:
                SaveState;
            RestoreStateC:
                RestoreState;
            SetCounterC:
                SetCounter;
            UpdateLutC:
                DoUpdateLUT;
            SetCountC:
                SetErosionDilationCount;
            PropagateLutC:
                DoPropagate(1);
            PropagateSpatialC:
                DoPropagate(2);
            PropagateDensityC:
                DoPropagate(3);
            SetSpacingC:
                SetSliceSpacing;
            RequiresC:
                CheckVersion;
            SetOptionsC:
                SetOptions;
            SubtractBackgroundC:
                SubtractBackground;
            MoveWindowC:
                MoveCurrentWindow;
            UserCodeC:
                DoUserCode;
            InvertLutC:  begin
                    InvertPalette;
                    UpdateLUT;
                end;
            OpenSerialC:
                OpenSerial;
            PutSerialC:
                PutSerial;
            SetCursorC:
                DoSetCursor;
            SetVideoC:
                SetVideoOptions;
            AcquireC:
                DoAcquire;
            CallFilterC:
                CallFilterPlugin;
            PhotoModeC:
                DoPhotoMode;
            RGBToIndexedC:
                RGBToIndexed;
            SurfacePlotC:
                PlotSurface;
            SelectWindowC:
                DoSelectWindow;
            NewTextWindowC:
                DoNewTextWindow;
            CaptureColorC:
                CaptureColor;
            GetThresholdC:
                GetThreshold;
            AverageSlicesC:
                DoAverageSlices;
            SortPaletteC:
                SortPalette;
            ProjectC:
                DoProject;
            ScaleConvolutionsC:
                ScaleConvolutions := GetBooleanArg;
            ImageMathC:
                ImageMath;
            PasteLiveC:
                PasteLive;
            GetPlotDataC:
                GetPlotData;
            DeleteC:
                DoDelete;
            GetScaleC:
                GetScale;
            AutoOutlineC:
                DoAutoOutline;
            FilterC:
                DoFilter;
            SetSaveAsC:
                SetSaveAsMode;
            CalibrateC:
                DoCalibrate;
            CallExportC:
                CallExportPlugin;
            IndexedToRGBC:
                ConvertEightBitColorToRGB;
            MakeMovieC:
                DoMakeMovie;
       SetProjectionC:
          SetProjection;
       GetHistogramC:
              DoGetHistogram;
          fftC:
              doFFTMacro;
          GetFileInfoC:
              GetFileInfo;
          SelectToolC:
              DoSelectTool;
          BinaryC:
              DoBinary;
        end; {case}
        OptionKeyWasDown := false;
        if not macro then begin
                Token := DoneT;
                KillRoi;
            end;
        if TickCount > MacroTicks then begin
                if EventAvail(everyEvent, theEvent) then; {Allows background tasks to run}
                if CommandPeriod then begin
                        Token := DoneT;
                        KillRoi;
                    end;
                MacroTicks := TickCount + 15;
            end;
    end;


    procedure DoCompoundStatement;
    begin
        if token <> BeginT then
            MacroError('"begin" expected');
        GetToken;
        while (token <> endT) and (token <> DoneT) do begin
                DoStatement;
                GetToken;
                if Token = SemiColon then
                    GetToken
                else if token <> EndT then
                    MacroError(EndExpected);
            end;
    end;


    procedure SkipCompoundStatement;
        var
            count: integer;
    begin
        count := 1;
        repeat
            GetToken;
            case token of
                beginT:
                    count := count + 1;
                endT:
                    count := count - 1;
                DoneT:  begin
                        MacroError('"end" expected');
                        exit(SkipCompoundStatement);
                    end;
                otherwise
            end; {case}
        until count = 0;
    end;


    procedure DoDeclarations;
    begin
        if token = SemiColon then
            GetToken;
        if token = VarT then begin
                GetToken;
                while ((token = Identifier) or (token = variable) or (token = StringVariable)) and (Token <> DoneT) do
                    DoDeclaration;
            end;
    end;


    procedure DoFor;
        var
            SavePC, StackLoc: integer;
            StartValue, EndValue, i: LongInt;
    begin
        StackLoc := GetVar;
        GetToken;
        if token <> AssignOp then begin
                MacroError('":=" expected');
                exit(DoFor);
            end;
        StartValue := GetInteger;
        if token = DoneT then
            exit(DoFor);
        GetToken;
        if token <> ToT then begin
                MacroError('"to" expected');
                exit(DoFor);
            end;
        EndValue := GetInteger;
        if token = DoneT then
            exit(DoFor);
        GetToken;
        if token <> DoT then begin
                MacroError(DoExpected);
                exit(DoFor);
            end;
        SavePC := pc;
        if StartValue > EndValue then begin
                GetToken;
                SkipStatement
            end
        else
            for i := StartValue to EndValue do
                with MacrosP^ do begin
                        Stack[StackLoc].value := i;
                        pc := SavePC;
                        GetToken;
                        DoStatement;
                        LoopCounter := LoopCounter + 1;
                        if LoopCounter >= MaxLoopCount then begin
                            if CommandPeriod then
                                token := DoneT;
                            LoopCounter := 0;
                        end;
                        if Token = DoneT then
                            leave;
                        if Digitizing then
                            DoCapture;
                    end;
    end;


    procedure SkipFor;
    begin
        GetToken;
        SkipPartialStatement;
        GetToken;
        if token <> doT then
            MacroError(DoExpected);
        GetToken;
        SkipStatement
    end;


    procedure DoAssignment;
        var
            SaveStackLoc: integer;
    begin
        SaveStackLoc := TokenStackLoc;
        GetToken;
        if token <> AssignOp then begin
                MacroError('":=" expected');
                exit(DoAssignment);
            end;
        MacrosP^.stack[SaveStackLoc].value := GetBooleanExpression;
    end;


    procedure DoStringAssignment;
        var
            SaveStackLoc: integer;
            str: Str255;
    begin
        SaveStackLoc := TokenStackLoc;
        GetToken;
        if token <> AssignOp then begin
                MacroError('":=" expected');
                exit(DoStringAssignment);
            end;
        str := GetString;
        if token <> DoneT then
            with MacrosP^.stack[SaveStackLoc] do
                if StringH <> nil then
                    StringH^^ := str;
    end;


    procedure SkipPartialStatement;
        var
            done: Boolean;
    begin
        done := token = DoneT;
        while not done do begin
                case token of
                    ThenT, DoT, SemiColon, EndT, ElseT, UntilT:  begin
                            PutTokenBack;
                            done := true;
                        end;
                    DoneT, BeginT, ForT, IfT, WhileT, RepeatT:  begin
                            MacroError('end of statement expected');
                            done := true;
                        end;
                    otherwise
                        GetToken;
                end;
            end;
    end;


    procedure DoIf;
        var
            isTrue: boolean;
    begin
        isTrue := GetBoolean;
        GetToken;
        if token <> ThenT then
            MacroError(ThenExpected);
        if isTrue then begin
                GetToken;
                DoStatement
            end
        else begin
                GetToken;
                SkipStatement;
            end;
        GetToken;
        if token = elseT then begin
                if isTrue then begin
                        GetToken;
                        SkipStatement
                    end
                else begin
                        GetToken;
                        DoStatement;
                    end;
            end
        else
            PutTokenBack;
    end;


    procedure SkipIf;
    begin
        GetToken;
        SkipPartialStatement;
        GetToken;
        if token <> thenT then
            MacroError(ThenExpected);
        GetToken;
        SkipStatement;
        GetToken;
        if token <> elseT then
            PutTokenBack
        else begin
                GetToken;
                SkipStatement
            end
    end;


    procedure DoWhile;
        var
            isTrue: boolean;
            SavePC: integer;
    begin
        SavePC := pc;
        repeat
            pc := SavePC;
            isTrue := GetBoolean;
            GetToken;
            if token <> doT then
                MacroError(DoExpected);
            if isTrue then begin
                    GetToken;
                    DoStatement
                end
            else begin
                    GetToken;
                    SkipStatement;
                end;
            if Digitizing then
                DoCapture;
            LoopCounter := LoopCounter + 1;
            if LoopCounter >= MaxLoopCount then begin
                if CommandPeriod then
                    token := DoneT;
                LoopCounter := 0;
            end;
        until not isTrue or (Token = DoneT);
    end;


    procedure SkipWhile;
    begin
        GetToken;
        SkipPartialStatement;
        GetToken;
        if token <> doT then
            MacroError(DoExpected);
        GetToken;
        SkipStatement
    end;


    procedure DoRepeat;
        var
            isTrue: boolean;
            SavePC: integer;
    begin
        SavePC := pc;
        isTrue := true;
        repeat
            pc := SavePC;
            GetToken;
            while (token <> untilT) and (token <> DoneT) do begin
                    DoStatement;
                    GetToken;
                    if Token = SemiColon then
                        GetToken;
                    LoopCounter := LoopCounter + 1;
                    if LoopCounter >= MaxLoopCount then begin
                        if CommandPeriod then
                            token := DoneT;
                        LoopCounter := 0;
                    end;
                end;
            if token <> untilT then
                MacroError(UntilExpected);
            isTrue := GetBoolean;
            if Digitizing then
                DoCapture;
        until isTrue or (Token = DoneT);
    end;


    procedure SkipRepeat;
    begin
        GetToken;
        while (token <> untilT) and (token <> DoneT) do begin
                SkipStatement;
                GetToken;
                if token = SemiColon then
                    GetToken
                else if token <> UntilT then
                    MacroError(UntilExpected);
            end;
        GetToken;
        SkipPartialStatement;
    end;


    procedure DoArrayAssignment;
        var
            SaveArrayType: ArrayType;
            index, LutValue, PixelValue, RegisterValue: LongInt;
            SyncChannel: integer;
    begin
        SaveArrayType := ArrayType(MacroCommand);
        GetToken;
        if token <> LeftBracket then
            MacroError('"[" expected');
        Index := GetInteger;
        GetToken;
        if token <> RightBracket then
            MacroError('"]" expected');
        GetToken;
        if token <> AssignOp then
            MacroError('":=" expected');

        if SaveArrayType = BufferA then begin
                CheckIndex(index, 0, MaxLine - 1);
                PixelValue := GetInteger;
                RangeCheck(PixelValue);
                if token <> DoneT then
                    MacrosP^.aLine[index] := PixelValue;
                exit(DoArrayAssignment);
            end;

        if SaveArrayType in [RedLutA, BlueLutA, GreenLutA] then begin
                RangeCheck(index);
                LutValue := GetInteger;
                RangeCheck(LutValue);
                if token <> DoneT then
                    with info^.cTable[index].rgb do
                        case SaveArrayType of
                            RedLutA:
                                red := bsl(LutValue, 8);
                            GreenLutA:
                                green := bsl(LutValue, 8);
                            BlueLutA:
                                blue := bsl(LutValue, 8);
                        end;
                exit(DoArrayAssignment);
            end;

        if SaveArrayType = ScionA then begin
                if framegrabber <> ScionLG3 then
                    MacroError('No Scion LG-3');
                if Token <> DoneT then
                    CheckIndex(index, 1, 4);
                if Token = DoneT then
                    exit(DoArrayAssignment);
                if index = 3 then
                    MacroError('DataIn is read-only');
                RegisterValue := GetInteger;
                if token <> DoneT then begin
                        if RegisterValue < 0 then
                            RegisterValue := 0;
                        if RegisterValue > 255 then
                            RegisterValue := 255;
                        case index of
                            1:  begin
                                    LG3DacA := RegisterValue;
                                    DacAReg^ := LG3DacA
                                end;
                            2:  begin
                                    LG3DacB := RegisterValue;
                                    DacBReg^ := LG3DacB
                                end;
                            4:  begin
                                    LG3DataOut := band(RegisterValue, $f);
                                    if SyncMode = SeparateSync then
                                        SyncChannel := 3
                                    else
                                        SyncChannel := VideoChannel;
                                    ChannelReg^ := bor(LG3DataOut, bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6)));
                                end;
                        end; {case}
                    end;
                exit(DoArrayAssignment);
            end;

        if SaveArrayType = PlotDataA then begin
                CheckIndex(index, 0, MaxLine - 1);
                PlotData^[index] := GetExpression;
                exit(DoArrayAssignment);
            end;

        CheckIndex(index, 1, MaxMeasurements);
        if token <> DoneT then
            case SaveArrayType of
                rAreaA:
                    mArea^[Index] := GetExpression;
                rMeanA:
                    mean^[Index] := GetExpression;
                rStdDevA:
                    sd^[Index] := GetExpression;
                rXA:
                    xcenter^[Index] := GetExpression;
                rYA:
                    ycenter^[Index] := GetExpression;
                rLengthA:
                    plength^[Index] := GetExpression;
                rMinA:
                    mMin^[Index] := GetExpression;
                rMaxA:
                    mMax^[Index] := GetExpression;
                rMajorA:
                    MajorAxis^[Index] := GetExpression;
                rMinorA:
                    MinorAxis^[Index] := GetExpression;
                rAngleA:
                    orientation^[Index] := GetExpression;
                rUser1A:
                    User1^[Index] := GetExpression;
                rUser2A:
                    User2^[Index] := GetExpression;
                otherwise
                    MacroError('Read-only array');
            end; {case}
    end;


    procedure PushArguments (var nArgs: integer);
        var
            arg: array[1..MaxArgs] of extended;
            StringArg: array[1..MaxArgs] of boolean;
            i, nStringArgs: integer;
            TempName: SymbolType;
    begin
        nArgs := 0;
        nStringArgs := 0;
        GetToken;
        while token in [Variable, StringVariable, StringLiteral, NumericLiteral, TrueT, FalseT, FunctionT, UserFunctionT, StringFunctionT, ArrayT, comma, MinusOp, LeftParen] do begin
                if token = comma then
                    GetToken;
                if nArgs < MaxArgs then
                    nArgs := nArgs + 1
                else
                    MacroError('Too many arguments');
                if (token = StringVariable) or (token = StringLiteral) or (token = StringFunctionT) then begin
                        nStringArgs := nStringArgs + 1;
                        arg[nArgs] := 0.0;
                        StringArg[nArgs] := true;
                        if token = StringFunctionT then
                            TokenStr := DoStringFunction;
                    end
                else begin
                        PutTokenBack;
                        arg[nArgs] := GetBooleanExpression;
                        StringArg[nArgs] := false;
                    end;
                if nStringArgs > 1 then
                    MacroError('No more than one string argument allowed');
                GetToken;
            end;
        if token <> RightParen then
            MacroError(RightParenExpected);
        for i := 1 to nArgs do begin
                if TopOfStack < MaxMacroStackSize then
                    TopOfStack := TopOfStack + 1
                else
                    MacroError(StackOverflow);
                with MacrosP^.stack[TopOfStack] do begin
                        value := arg[i];
                        StringH := nil;
                        if StringArg[i] then begin
                                vType := StringVar;
                                StringsAllocated := true;
                                StringH := str255H(NewHandle(SizeOf(str255)));
                                if StringH = nil then begin
                                        MacroError('Out of memory');
                                        Token := DoneT
                                    end
                                else
                                    StringH^^ := TokenStr;
                            end
                        else
                            vType := RealVar;
                        value := arg[i];
                    end;
            end;
    end;


    procedure PushFunctionResult(SymbolLoc: integer; var ReturnValueLoc: integer);
        var
            StackLoc: integer;
    begin
        if TopOfStack >= MaxMacroStackSize then begin
                MacroError(StackOverflow);
                exit(PushFunctionResult);
            end;
        TopOfStack := TopOfStack + 1;
        ReturnValueLoc := TopOfStack;
        with MacrosP^.stack[TopOfStack] do begin
                SymbolTableIndex := SymbolLoc;
                value := 0.0;
                StringH := nil;
            end;
        with macrosP^.stack[TopOfStack] do
            case token of
                IntegerT:
                    vType := IntVar;
                RealT:
                    vType := RealVar;
                BooleanT:
                    vType := BooleanVar;
                StringT:  begin
                        vType := StringVar;
                        StringH := str255H(NewHandle(SizeOf(str255)));
                        StringsAllocated := true;
                        if StringH = nil then begin
                                MacroError('Out of memory');
                                Token := DoneT
                            end
                        else
                            StringH^^ := '';
                    end;
                otherwise
            end;
    end;


    procedure DoUserFunction;
        var
            SavePC, SavePCStart, NewPCStart, SaveStackLoc, nArgs, i: integer;
            SaveSymbolTableLoc, ReturnValueLoc: integer;
            SaveName, NewFuncName: SymbolType;
            SaveStringsAllocated: boolean;
    begin
        NewPCStart := TokenLoc;
        NewFuncName := TokenSymbol;
        SaveStackLoc := TopOfStack;
        SaveSymbolTableLoc := SymbolTableLoc;
        SaveStringsAllocated := StringsAllocated;
        StringsAllocated := false;
        GetToken;
        if token = LeftParen then
            PushArguments(nArgs)
        else begin
                nArgs := 0;
                PutTokenBack;
            end;
        SavePCStart := PCStart;
        PCStart := NewPCStart;
        LineStartPC := NewPCStart - 1;
        SaveName := MacroOrProcName;
        MacroOrProcName := NewFuncName;
        SavePC := pc;
        pc := pcStart;
        if nArgs > 0 then begin
                GetLeftParen;
                i := 0;
                GetToken;
                while token in [Identifier, Variable, StringVariable, comma, colon, SemiColon, RealT, IntegerT, BooleanT, StringT] do begin
                        if (token = Identifier) or (token = Variable) or (token = StringVariable) then begin
                                if i < nArgs then
                                    i := i + 1
                                else
                                    MacroError('Too many formal arguments');
                                MacrosP^.stack[SaveStackLoc + i].SymbolTableIndex := SymbolTableloc;
                            end;
                        GetToken;
                    end;
                if Token = VarT then
                    MacroError('VAR parameters not supported');
                if i < nArgs then
                    MacroError('Too few formal arguments');
                if token <> RightParen then
                    MacroError(RightParenExpected);
            end;
        GetToken;
        if token <> colon then
            MacroError('":" expected');
        GetToken;
        if (token <> IntegerT) and (token <> RealT) and (token <> BooleanT) and (token <> StringT) then
            MacroError('"integer", "real", "boolean" or "string" expected');
        PushFunctionResult(SaveSymbolTableLoc, ReturnValueLoc);
        GetToken;
        if (token = LeftParen) and (nArgs = 0) then
            MacroError('Arguments not expected');
        DoDeclarations;
        DoCompoundStatement;
        pc := SavePC;
        with MacrosP^.stack[ReturnValueLoc] do begin
      {Get return value from stack}
            if (vType = StringVar) and (StringH <> nil) then begin
                TokenStr := StringH^^;
                TokenValue := 0.0;
            end else begin
                TokenValue := value;
                TokenStr := 'No return string';
            end;
        end;
        if StringsAllocated then
            DeallocateStrings(SaveStackLoc + 1, TopOfStack);
        StringsAllocated := SaveStringsAllocated;
        TopOfStack := SaveStackLoc;
        pcStart := SavePCStart;
        MacroOrProcName := SaveName;
    end; {DoUserFunction}


    procedure DoProcedure;
        var
            SavePC, SavePCStart, NewPCStart, SaveStackLoc, nArgs, i: integer;
            SaveProcName, NewProcName: SymbolType;
            SaveStringsAllocated: boolean;
    begin
        NewPCStart := TokenLoc;
        NewProcName := TokenSymbol;
        SaveStackLoc := TopOfStack;
        SaveStringsAllocated := StringsAllocated;
        StringsAllocated := false;
        GetToken;
        if token = LeftParen then
            PushArguments(nArgs)
        else begin
                nArgs := 0;
                PutTokenBack;
            end;
        SavePCStart := PCStart;
        PCStart := NewPCStart;
        LineStartPC := NewPCStart - 1;
        SaveProcName := MacroOrProcName;
        MacroOrProcName := NewProcName;
        SavePC := pc;
        pc := pcStart;
        if nArgs > 0 then begin
                GetLeftParen;
                i := 0;
                GetToken;
                while token in [Identifier, Variable, StringVariable, comma, colon, SemiColon, RealT, IntegerT, BooleanT, StringT] do begin
                        if (token = Identifier) or (token = Variable) or (token = StringVariable) then begin
                                if i < nArgs then
                                    i := i + 1
                                else
                                    MacroError('Too many formal arguments');
                                MacrosP^.stack[SaveStackLoc + i].SymbolTableIndex := SymbolTableloc;
                            end;
                        GetToken;
                    end;
                if Token = VarT then
                    MacroError('VAR parameters not supported');
                if i < nArgs then
                    MacroError('Too few formal arguments');
                if token <> RightParen then
                    MacroError(RightParenExpected);
            end;
        GetToken;
        if (token = LeftParen) and (nArgs = 0) then
            MacroError('Arguments not expected');
        DoDeclarations;
        DoCompoundStatement;
        pc := SavePC;
        if StringsAllocated then
            DeallocateStrings(SaveStackLoc + 1, TopOfStack);
        StringsAllocated := SaveStringsAllocated;
        TopOfStack := SaveStackLoc;
        pcStart := SavePCStart;
        MacroOrProcName := SaveProcName;
    end;


    procedure CannotBeginWithThis;
        var
            str: str255;
    begin
        str := '';
        ConvertTokenToString(str);
        MacroError(concat('Statement cannot begin with ', '"', str, '"'));
    end;


    procedure DoFunctionAssignment;
        var
            SaveStackLoc: integer;
            value: extended;
    begin
        LookupVariable;
        SaveStackLoc := TokenStackLoc;
        GetToken;
        if token <> AssignOp then begin
                MacroError('":=" expected');
                exit(DoFunctionAssignment);
            end;
        with MacrosP^.stack[SaveStackLoc] do begin
            if (vType =StringVar) and (StringH <> nil) then
                StringH^^ := GetString
            else
                value := GetBooleanExpression;
        end;
    end;


    procedure DoStatement;
    begin
        case token of
            BeginT:
                DoCompoundStatement;
            CommandT:
                ExecuteCommand;
            ForT:
                DoFor;
            IfT:
                DoIf;
            WhileT:
                DoWhile;
            RepeatT:
                DoRepeat;
            Identifier:
                MacroError('Undefined identifier');
            Variable:
                DoAssignment;
            StringVariable:
                DoStringAssignment;
            ArrayT:
                DoArrayAssignment;
            ProcedureT:
                DoProcedure;
            ElseT:
                MacroError('Statement expected');
            FunctionT, StringFunctionT:
                MacroError('Variable expected');
            UserFunctionT:
                DoFunctionAssignment;
            SemiColon:
                PutTokenBack; {Null statement}
            otherwise
                CannotBeginWithThis
        end;
    end;


    procedure SkipStatement;
    begin
        case token of
            BeginT:
                SkipCompoundStatement;
            ForT:
                SkipFor;
            IfT:
                SkipIf;
            WhileT:
                SkipWhile;
            RepeatT:
                SkipRepeat;
            CommandT, Variable, StringVariable, ArrayT, ProcedureT, UserFunctionT:
                SkipPartialStatement;
            DoneT:
                ; {Aborting the macro}
            SemiColon, EndT, ElseT, UntilT:
                PutTokenBack; {These tokens can follow a statement}
            otherwise
                CannotBeginWithThis
        end;
    end;



    procedure RunMacro (nMacro: integer);
        var
            count: integer;
            str: str255;
            SaveInfo: InfoPtr;
    begin
        DefaultFileName := '';
        str := '';
        nSaves := 0;
        DefaultRefNum := 0;
        count := 0;
        pcStart := MacroStart[nMacro];
        pc := pcStart;
        SavePC := pcStart;
        LineStartPC := pcStart;
        token := NullT;
        macro := true;
        DoOption := false;
        SaveInfo := info;
        TopOfStack := nGlobals;
        MacroOrProcName := BlankSymbol;
        StringsAllocated := false;
        InPhotoMode := false;
        RoutinesCalled := [];
        MacroTicks := TickCount + 15;
        LoopCounter := 0;
        GetToken;
        DoDeclarations;
        DoCompoundStatement;
        if (info <> SaveInfo) and (info <> NoInfo) then
            SelectWindow(info^.wptr);
        with info^, RoiRect do begin
                if ((right - left) <= 0) or ((bottom - top) <= 0) then
                    KillRoi;
            end;
        if info^.RoiShowing then
            if not (OpPending and (CurrentOp = PasteOp)) then begin
              KIllRoi;
              RestoreRoi;
            end;
        macro := false;
        if StringsAllocated then
            DeallocateStrings(nGlobals + 1, TopOfStack);
        if InPhotoMode then
            RestoreScreen;
    end;


    procedure RunKeyMacro (ch: char; KeyCode: integer);
        const
            FunctionKey = 16;
        var
            i: integer;
    begin
        if (ord(ch) = 0) then
            exit(RunKeyMacro);
        if (ch >= 'A') and (ch <= 'Z') then
            ch := chr(ord(ch) + 32); {Convert to lower case}
        if ord(ch) = FunctionKey then
            case KeyCode of
                122:
                    ch := 'A';
                120:
                    ch := 'B';
                99:
                    ch := 'C';
                118:
                    ch := 'D';
                96:
                    ch := 'E';
                97:
                    ch := 'F';
                98:
                    ch := 'G';
                100:
                    ch := 'H';
                101:
                    ch := 'I';
                109:
                    ch := 'J';
                103:
                    ch := 'K';
                111:
                    ch := 'L';
                105:
                    ch := 'M';
                107:
                    ch := 'N';
                113:
                    ch := 'O';
                otherwise
            end;
        for i := 1 to nMacros do
            if ch = MacroKey[i] then begin
                    RunMacro(i);
                    leave;
                end;
    end;



end.